Excel VBA - Power Query import with new sheets

Copper Contributor

Hello,
I have a problem with Excel VBA. I want to import several textfiles in Excel with Power Query (Power Query is needed because the files need to be connected to the folder after they are imported). Every textfile needs to be in a new Excel sheet.

 

The VBA code should work like this:

1.) Open the Windows explorer
2.) Select all textfiles that are saved in the choosen folder
3.) Import the first textfile in the curren Exel sheet
4.) Create a new Excel sheet
5.) Import the next textfile in the new sheet
6.) Repeat 5-6 until every textfile is imported

 

The textfiles I want to import have all the same structure. The columns are seperated by commas.

I already used the makrorecorder where I imported one textfile and after that I added a new Excel sheet. This is the code (I hope this helps):

 

 

Sub Makro1()
'
' Makro1 Makro
'

'
ActiveWorkbook.Queries.Add Name:="aacg us", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Quelle = Csv.Document(File.Contents(""C:\Users\Thoma\Downloads\Neuer Ordner\aacg.us.txt""),[Delimiter="","", Columns=10, Encoding=1252, QuoteStyle=QuoteStyle.None])," & Chr(13) & "" & Chr(10) & " #""Höher gestufte Header"" = Table.PromoteHeaders(Quelle, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & " #""Analysierte JSON"" = Table.TransformColumns(#""Höher gestufte Header"",{{""<OPEN>"", Json.Docum" & _
"ent}, {""<HIGH>"", Json.Document}, {""<LOW>"", Json.Document}, {""<CLOSE>"", Json.Document}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Analysierte JSON"""
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""aacg us"";Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [aacg us]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "aacg_us"
.Refresh BackgroundQuery:=False
End With
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Sheets.Add After:=ActiveSheet
End Sub

 

 

I also added some sample data so you can see how it is structured.

Thank you so much for your help!

0 Replies