I want to import all the workbooks from this folder into the active sheet. (Path is in the code).
So far my code is this:
Option Explicit
Sub load_all_from_folder()
Dim idx As Integer
Dim fpath As String
Dim fname As String
idx = 0
fpath = "/Users/charliekeegan/Desktop/Tester1/"
fname = Dir(fpath & "*.csv")
While (Len(fname) > 0)
idx = idx + 1
Sheets("Sheet" & idx).Select
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" _
& fpath & fname, Destination:=Range("A1"))
.Name = "a" & idx
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
fname = Dir
End With
Wend
End Sub
The macro runs but nothing happens in my active sheet - can you see the problem?
Also do you know how i can delete all the sheets after they have been uploaded?
Related
Here is a flowchart of what I am trying to accomplish:
I have a list of cities:
Tokyo
Delhi
Shanghai
Sao+Paulo
Mexico+City
Cairo
Mumbai
Beijing
Dhaka
Osaka
Each of these cities has three .txt files pertaining to each in this format:
PopulationFile{}.txt
LocationFile{}.txt
CityFile{}.txt
Here is the complete list of files that are in the same folder:
PopulationFileTokyo?.txt
PopulationFileBeijing?.txt
PopulationFileCairo?.txt
PopulationFileDelhi?.txt
PopulationFileDhaka?.txt
PopulationFileMexico+City?.txt
PopulationFileMumbai?.txt
PopulationFileOsaka.txt
PopulationFileSao+Paulo?.txt
PopulationFileShanghai?.txt
LocationFileTokyo?.txt
LocationFileShanghai?.txt
LocationFileSao+Paulo?.txt
LocationFileOsaka.txt
LocationFileMumbai?.txt
LocationFileMexico+City?.txt
LocationFileDhaka?.txt
LocationFileDelhi?.txt
LocationFileCairo?.txt
LocationFileBeijing?.txt
CityFileTokyo?.txt
CityFileShanghai?.txt
CityFileSao+Paulo?.txt
CityFileOsaka.txt
CityFileMumbai?.txt
CityFileMexico+City?.txt
CityFileDhaka?.txt
CityFileDelhi?.txt
CityFileCairo?.txt
CityFileBeijing?.txt
Here's the goal:
Create sheets based on a list of values (in this case being Cities)
Use a range to iterate through specific file names (an example being PopulationFileTokyo.txt, then LocationFileTokyo.txt, CityFileTokyo.txt) to paste to Column 1, Column 2, and Column 3 on the {Cities} sheet (example Sheetname: Tokyo)
Loop insert .txt file data process for each city
Using a new Workbook, I want to automate this process. I want to
define the city list in VBA,
then, instruct VBA to create sheets based on this list of cities,
next, iterate through these sheets pasting the three relevant files for each city in the first three columns
The script should insert the city name from Cities into the file path/name to correctly insert relevant files to the relevant sheets (as shown after the 'Insert .txt files into columns' box in the flowchart)
Only the file name in the file path needs to be edited as all of these files are in the folder
Here is a Macro I created showing manual steps of this process (creating three sheets, then going back and inserting the relevant files):
Sub Macro3()
'
' Macro3 Macro
' Name sheet, create sheet, create sheet, insert data, insert data, insert data, switch sheet, insert data, insert data, insert data
'
'
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Tokyo"
Sheets.Add After:=ActiveSheet
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "Delhi"
Sheets.Add After:=ActiveSheet
Sheets("Sheet3").Name = "Shanghai"
Sheets("Tokyo").Select
Application.CutCopyMode = False
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;/Users/MyName/PycharmProjects/pythonProject7/PopulationFileTokyo" & Chr(10) & ".txt" _
, Destination:=Range("$A$2"))
.Name = "PopulationFileTokyo" & Chr(10) & ""
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.RefreshPeriod = False
.TextFilePromptOnRefresh = False
.TextFilePlatform = 10000
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Range("B2").Select
Application.CutCopyMode = False
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;/Users/MyName/PycharmProjects/pythonProject7/LocationFileTokyo" & Chr(10) & ".txt" _
, Destination:=Range("$B$2"))
.Name = "LocationFileTokyo" & Chr(10) & ""
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.RefreshPeriod = False
.TextFilePromptOnRefresh = False
.TextFilePlatform = 10000
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Range("C2").Select
Application.CutCopyMode = False
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;/Users/MyName/PycharmProjects/pythonProject7/CityFileTokyo" & Chr(10) & ".txt" _
, Destination:=Range("$C$2"))
.Name = "CityFileTokyo" & Chr(10) & ""
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.RefreshPeriod = False
.TextFilePromptOnRefresh = False
.TextFilePlatform = 10000
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Sheets("Delhi").Select
Range("A2").Select
Application.CutCopyMode = False
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;/Users/MyName/PycharmProjects/pythonProject7/PopulationFileDelhi" & Chr(10) & ".txt" _
, Destination:=Range("$A$2"))
.Name = "PopulationFileDelhi" & Chr(10) & ""
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.RefreshPeriod = False
.TextFilePromptOnRefresh = False
.TextFilePlatform = 10000
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Range("B2").Select
Application.CutCopyMode = False
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;/Users/MyName/PycharmProjects/pythonProject7/LocationFileDelhi" & Chr(10) & ".txt" _
, Destination:=Range("$B$2"))
.Name = "LocationFileDelhi" & Chr(10) & ""
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.RefreshPeriod = False
.TextFilePromptOnRefresh = False
.TextFilePlatform = 10000
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Range("C2").Select
Application.CutCopyMode = False
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;/Users/MyName/PycharmProjects/pythonProject7/CityFileDelhi" & Chr(10) & ".txt" _
, Destination:=Range("$C$2"))
.Name = "CityFileDelhi" & Chr(10) & ""
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.RefreshPeriod = False
.TextFilePromptOnRefresh = False
.TextFilePlatform = 10000
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Sheets("Shanghai").Select
Range("A2").Select
Application.CutCopyMode = False
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;/Users/MyName/PycharmProjects/pythonProject7/PopulationFileShanghai" & Chr(10) & ".txt" _
, Destination:=Range("$A$2"))
.Name = "PopulationFileShanghai" & Chr(10) & ""
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.RefreshPeriod = False
.TextFilePromptOnRefresh = False
.TextFilePlatform = 10000
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Range("B2").Select
Application.CutCopyMode = False
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;/Users/MyName/PycharmProjects/pythonProject7/LocationFileShanghai" & Chr(10) & ".txt" _
, Destination:=Range("$B$2"))
.Name = "LocationFileShanghai" & Chr(10) & ""
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.RefreshPeriod = False
.TextFilePromptOnRefresh = False
.TextFilePlatform = 10000
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Range("C2").Select
Application.CutCopyMode = False
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;/Users/MyName/PycharmProjects/pythonProject7/CityFileShanghai" & Chr(10) & ".txt" _
, Destination:=Range("$C$2"))
.Name = "CityFileShanghai" & Chr(10) & ""
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.RefreshPeriod = False
.TextFilePromptOnRefresh = False
.TextFilePlatform = 10000
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
Finally, the outcome should be 10 sheets named [Cities] with Column 1 containing PopulationFile{Cities}.txt, Column 2 containing LocationFile{Cities}.txt, and Column 3 containing CityFile{Cities}.txt. 30 .txt files should be imported into their proper sheets in the end.
Here is Python code that executes creating these files with the content written inside:
Cities.txt
Tokyo
Delhi
Shanghai
Sao+Paulo
Mexico+City
Cairo
Mumbai
Beijing
Dhaka
Osaka
readNames = open('Cities.txt', 'r').readlines()
print(readNames)
for i in readNames:
open('PopulationFile{}.txt'.format(i), 'w').write('Pop1\nPop2\nPop3')
open('LocationFile{}.txt'.format(i), 'w').write('Loc1\nLoc2\nLoc3')
open('CityFile{}.txt'.format(i), 'w').write('City1\nCity2\nCity3')
If any other information is needed or further clarification please ask!
Please, test the next code. But take care to eliminate the strange character from the end of the files name (a question mark in the text you show, and Chr(10) in your code, which is not allowed. A file name placed on two lines is not allowed by Windows...). So, PopulationFileTokyo?.txt should become PopulationFileTokyo.txt and so on. And read carefully the code lines comments before running it:
Sub testPopulateCities()
Dim wb As Workbook, foldPath As String, fileName As String, arrTxt
Dim arrC, cit, arrCol, cl, colNo As Long, sheetN As String, i As Long
'fill the cities array:
arrC = Split("Tokyo,Delhi,Shanghai,Sao+Paulo,Mexico+City,Cairo,Mumbai,Beijing,Dhaka,Osaka", ",")
arrCol = Split("Population,Location,City", ",") 'array of prefixes with meaning related to the insertion column
Set wb = Workbooks.Add(xlWBATWorksheet) 'create a new workbook with a single sheet
'insert the necessary sheets and naming them according to arrC array elements:
For Each cit In arrC
i = i + 1
If i = 1 Then
wb.Sheets(i).Name = cit 'name the first sheet
Else
wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count)).Name = cit 'insert and name the following sheets
End If
Next cit
foldPath = "C:\Users\RealName\PycharmProjects\pythonProject7\" 'The folder path where the text files exist. Take care of its ending backslash (\)!!!
fileName = dir(foldPath & "*.txt") 'determine the first file in the folder
Do While fileName <> ""
For Each cl In arrCol 'iterate between the array elements
If InStr(fileName, cl) > 0 Then 'if the element exists in the file name:
colNo = Application.match(cl, arrCol, 0) 'column where to insert data
sheetN = Split(fileName, ".")(0)
sheetN = Right(sheetN, Len(sheetN) - (Len(cl) + 4)) 'sheet name to insert data
Exit For
End If
Next
'place the text file content in an array, split by vbCrLf (Carriage return - linefeed combination):
arrTxt = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(foldPath & fileName, 1).ReadAll, vbCrLf)
wb.Sheets(sheetN).cells(2, colNo).Resize(UBound(arrTxt) + 1, 1) = Application.Transpose(arrTxt) ' drop the array content
fileName = dir() 'continue the iteration between files
Loop
MsgBox "Ready...", vbInformation, "Job done"
End Sub
I have adapted a code I found on here, which pulls in text files and pastes the data into new sheets. This file is supposed to name the sheets the name of the text file, but my text file names are too big. It seems excel sheets can be 31 characters long. How can I adjust this code to name the sheets using the first 31 characters of the text file names?
I would also like for the code to prompt me to pick the folder destination. I've tried a few things, but haven't figured it out yet.
Sub ImportManyTXTs_test()
Dim strFile As String
Dim ws As Worksheet
strFile = Dir("I:\path\*.lev")
Do While strFile <> vbNullString
Set ws = Sheets.Add
With ws.QueryTables.Add(Connection:= _
"TEXT;" & "I:\path\" & strFile, Destination:=Range("$A$1"))
.Name = strFile
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(xlYMDFormat, 1, 1)
.TextFileFixedColumnWidths = Array(22, 13, 13)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
strFile = Dir
Loop
End Sub
Change .Name = strFile to
If Len(strFile) < 31 Then
.Name = strFile
Else
.Name = Mid(strFile, 1, 31)
End If
Use the LEFT() function to only get the first 31 characters of your filename, like so:
Sub ImportManyTXTs_test()
Dim strFile As String
Dim ws As Worksheet
strFile = Dir("I:\path\*.lev")
Do While strFile <> vbNullString
Set ws = Sheets.Add
With ws.QueryTables.Add(Connection:= _
"TEXT;" & "I:\path\" & strFile, Destination:=Range("$A$1"))
.Name = LEFT(strFile,31)
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(xlYMDFormat, 1, 1)
.TextFileFixedColumnWidths = Array(22, 13, 13)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
strFile = Dir
Loop
End Sub
I managed to figure out how to get it to prompt for a folder location, but neither of the above suggestions worked. The sheets are still getting default labels.
Sub ImportManyTXTs_test()
Dim foldername As String
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
On Error Resume Next
foldername = .SelectedItems(1)
Err.Clear
On Error GoTo 0
End With
Dim strFile As String
Dim ws As Worksheet
strFile = Dir(foldername & "\" & "*.lev")
Do While strFile <> vbNullString
Set ws = Sheets.Add
With ws.QueryTables.Add(Connection:= _
"TEXT;" & foldername & "\" & strFile, Destination:=Range("$A$1"))
.Name = Left(strFile, 31)
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(xlYMDFormat, 1, 1)
.TextFileFixedColumnWidths = Array(22, 13, 13)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
strFile = Dir
Loop
End Sub
' using for each loop
For Each ws In ThisWorkbook.Sheets
ws.Rows("1:45").NumberFormat = "#"
ws.Rows("1:45").Replace _
What:="=", Replacement:="", _
SearchOrder:=xlByColumns, MatchCase:=True
Next
For Each ws In ThisWorkbook.Sheets
If Not IsEmpty(ws.Cells(16, 2).Value) Then
ws.Name = ws.Cells(16, 2).Value
End If
Next
I managed to solve my problem by adding this to the end of my code. My data files have a header which unfortunately uses a lot of "=" making excel import those items as equations. The instrument name is in the header which is what I want the sheets to be labelled.
Not sure why naming after file name wouldn't work.
I want to be able to click a button and select the file I want to import. I've done this but after it says my file has been imported nothing happens.
What am i missing?
Sub GetImportFileName()
Dim Filt As String
Dim Title As String
Dim FileName As Variant
Dim FilterIndex As Integer
Filt = "Comma Separated Files (*.csv),*.csv,"
FilterIndex = 5
Title = "Select a File to Import"
FileName = Application.GetOpenFilename _
(FileFilter:=Filt, _
Title:=Title)
If FileName = False Then
MsgBox "No file was selected."
Exit Sub
End If
MsgBox "You selected " & FileName
End Sub
I don't see any code that would import the CSV. You only acquire the FileName. You are missing something like this ( Comma (,) as delimiter)
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & fileName & "", Destination:=Range("$A$1" _
))
.CommandType = 0
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 852
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
I am able to import one text file into Excel using below code.
Sub test()
Sheet1.Cells(1, 1) = "Time"
Sheet1.Cells(1, 2) = "QueueName"
Sheet1.Cells(1, 3) = "Count"
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\temp\Sample.txt", Destination:=Range("$A$2") _
)**strong text**
.Name = "Sample"
.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
How do I alter it to import 4 different text files in a way that the files are imported into a single sheet with all the data aligned in following order
File 1 data
file 2 data
File 3 data
file 4 data
Means file 2 data should start where the file 1 data ends.
File 1 data may vary. So I do not know the starting range of the file 2 data.
What should be the Destination:=Range("$A$2")?
You can use GetOpenFilename excel property like this:
Sub Sample()
Dim myfiles
Dim i As Integer
myfiles = Application.GetOpenFilename(filefilter:="CSV Files (*.csv), *.csv", MultiSelect:=True)
If Not IsEmpty(myfiles) Then
For i = LBound(myfiles) To UBound(myfiles)
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & myfiles(i), Destination:=Range("A" & Rows.Count).End(xlUp).Offset(1, 0))
.Name = "Sample"
.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Next i
Else
MsgBox "No File Selected"
End If
End Sub
Hope this works for you.
I am having a problem with some VBA code. I'm running Excel 2010 on Windows 7 Enterprise.
I'm trying to read in several tab-delimited text files from a folder and put them onto separate sheets in one Excel workbook. To do this, I'm using a Query Table. In debugging, I have a problem with .Refresh BackgroundQuery:=False. When it reaches this line, it throws a 1004 run-time error, stating that Excel cannot find the text file to refresh this external data range. I don't know why this is occurring. I know that the Query Table isn't created until it reads this line, which makes debugging difficult. Here is the code. Any help would be much appreciated. Thanks in advance!
Sub LoadPipeDelimitedFiles()
Dim idx As Integer
Dim fname As String
idx = 0
fname = Dir("C:\files\*.txt")
While (Len(fname) > 0)
idx = idx + 1
Sheets("Sheet" & idx).Select
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fname, Destination:=Range("A1"))
.Name = "a" & idx
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
fname = Dir
End With
Wend
End Sub
Here is the correction:
Sub LoadPipeDelimitedFiles()
Dim idx As Integer
Dim fpath As String
Dim fname As String
Dim f_dummy As String
idx = 0
fpath = "C:\files\"
f_dummy = fpath & "*.txt"
fname = Dir(f_dummy)
While (Len(fname) > 0)
idx = idx + 1
Sheets("Sheet" & idx).Select
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" _
& fpath & fname, Destination:=Range("A1"))
.Name = "a" & idx
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
fname = Dir
End With
Wend
End Sub
Change the line With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fname, Destination:=Range("A1"))
to
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & "C:\files\" & fname, Destination:=Range("A1"))
You fname just has the name of the file and not the full path
Also avoid using .Select and fully qualify your Objects.
INTERESTING READ
Your code can be written as
Sub LoadPipeDelimitedFiles()
Dim idx As Integer
Dim fname As String, FullName As String
Dim ws As Worksheet
idx = 0
fname = Dir("C:\*.txt")
While (Len(fname) > 0)
FullName = "C:\" & fname
idx = idx + 1
Set ws = ThisWorkbook.Sheets("Sheet" & idx)
With ws.QueryTables.Add(Connection:="TEXT;" & _
FullName, Destination:=ws.Range("A1"))
'
'~~> Rest of the code
'
fname = Dir
End With
Wend
End Sub