Related
I have a Macro that loads a flat file into the current sheet. It searches a subfolder for a .dat file of the same name as the active sheet and loads in the data. I want to transition this to a vbs script that will loop through all of the sheets in the workbook and import all the data. I cannot use a macro because when the workbook is open and I try to do this, excel runs out of memory. Below is the macro:
Sub LoadData()
Dim xStrPath As String
Dim theSheet As Worksheet
Dim xFile As String
Dim xCount As Long
Dim oneCell As Range
answer = MsgBox("Are you sure you want to reload data? This will remove all existing data.", vbYesNo + vbQuestion, "Warning!")
If answer = vbYes Then
Set theSheet = Application.ActiveWorkbook.ActiveSheet
theSheet.Rows(5 & ":" & theSheet.Rows.Count).Delete
xStrPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
xFile = xStrPath & "\Old_Data\" & theSheet.Name & ".dat"
With theSheet.QueryTables.Add(Connection:="TEXT;" _
& xStrPath & "\Old_Data\" & theSheet.Name & ".dat", Destination:=theSheet.Range("A5"))
.Name = "a" & xCount
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlMSDOS
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = ","
.TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
For Each oneColumn In theSheet.UsedRange.Columns
With oneColumn
.ColumnWidth = 40
End With
Next oneColumn
Else
'do nothing
End If
End Sub
And below is the VBScript I tried to run:
Dim xStrPath
Dim theSheet
Dim xFile
Dim xCount
Dim oneCell
Dim theFile
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
Set xStrPath = WshShell.CurrentDirectory
Set theFile = GetObject(xStrPath & "\Base_Tables_Template.xlsm")
For Each theSheet In theFile
'Set theSheet = Application.ActiveWorkbook.ActiveSheet
theSheet.Rows(5 & ":" & theSheet.Rows.Count).Delete
xFile = xStrPath & "\Old_Data\" & theSheet.Name & ".dat"
With theSheet.QueryTables.Add(Connection:="TEXT;" _ & xStrPath & "\Old_Data\" & theSheet.Name & ".dat", Destination:=theSheet.Range("A5"))
.Name = "a" & xCount
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlMSDOS
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = ","
.TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
For Each oneColumn In theSheet.UsedRange.Columns
With oneColumn
.ColumnWidth = 40
End With
Next oneColumn
Next theSheet
The VBScript is giving me an expected ')' error on line 18 char 49:
This line is
With theSheet.QueryTables.Add(Connection:="TEXT;" _ & xStrPath & "\Old_Data\" & theSheet.Name & ".dat", Destination:=theSheet.Range("A5"))
This should be behaving the same as the macro. Why would the code expect a parenthesis when the macro executes just fine?
I have a sheet with Item names in the firs row.
I am using a Forloop to pass trough the cells in row 1 - i.
I use the value content of each cell to import a column from a .CSV file in the corresponding cell below it in row 2, by using j for that.
However, I have some .CSV files that are missing and I need to move on to the next cell in row 2, while moving on to the next cell in row 1. Basically skipping a column.
What I have so far is:
Dim FSO As Object
Dim Folder As Object
Dim File As String
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder("C:\Users\Betty\AppData\Roaming\MetaQuotes\Terminal\B4D9BCD10BE9B5248AFCB2BE2411BA10\MQL4\Files")
For i = 2 To HCP.Cells(1, HCP.Columns.Count).End(xlToLeft).Column
Item = HCP.Cells(1, i).Value
FilePath = Folder & "\" & Item & "1440.CSV"
If Item = "" Or Dir(FilePath) = "" Then GoTo Continue
j = HCP.Cells(2, HCP.Columns.Count).End(xlToLeft).Column
With HCP.QueryTables.Add(Connection:="TEXT;" & FilePath, Destination:=HCP.Cells(2, j + 1))
.TextFileParseType = xlDelimited
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(9, 9, 9, 9, 9, 1, 9, 9, 9, 9)
.Refresh BackgroundQuery:=False
End With
Continue:
Next
I need the column index of j to be corresponding to the column index of i at all times.
I would avoid using GoTo Continue. Just check the negative of your statements before entering the loop. You are also missing some End If statement in both your question and solution.
I left comments showing where the code will skip to if either Item or Dir are blank. Same result, just cleaner code.
For i = 2 To HCP.Cells(1, HCP.Columns.Count).End(xlToLeft).Column
Item = HCP.Cells(1, i).Value
FilePath = Folder & "\" & Item & "1440.CSV"
If Item <> "" Or Dir(FilePath) <> "" Then 'Test Here
j = HCP.Cells(2, HCP.Columns.Count).End(xlToLeft).Column
If j <> i Then j = i
With HCP.QueryTables.Add(Connection:="TEXT;" & FilePath, Destination:=HCP.Cells(2, j))
.TextFileParseType = xlDelimited
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(9, 9, 9, 9, 9, 1, 9, 9, 9, 9)
.Refresh BackgroundQuery:=False
End With
End If 'Skips to here if either are blank.
Next i
I figured it out. This is what I am using now.
For i = 2 To HCP.Cells(1, HCP.Columns.Count).End(xlToLeft).Column
Item = HCP.Cells(1, i).Value
FilePath = Folder & "\" & Item & "1440.CSV"
If Item = "" Or Dir(FilePath) = "" Then GoTo Continue
j = HCP.Cells(2, HCP.Columns.Count).End(xlToLeft).Column
If j <> i Then j = i
With HCP.QueryTables.Add(Connection:="TEXT;" & FilePath, Destination:=HCP.Cells(2, j))
.TextFileParseType = xlDelimited
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(9, 9, 9, 9, 9, 1, 9, 9, 9, 9)
.Refresh BackgroundQuery:=False
End With
Continue:
Next
And this is the result:
Please, feel free to make any other suggestions.
Solution 3: Nested ForLoop with Nested IfStatement
For i = 1 To BS.Cells(1, BS.Columns.Count).End(xlToLeft).Column
For j = 1 To BS.Cells(2, BS.Columns.Count - 1).End(xlToLeft).Column
Item = BS.Cells(1, i).Value
FilePath = Folder & "\" & Item & "1440.CSV"
If ((Item <> "") Or (Dir(FilePath) <> "") And (i = j)) Then
With BS.QueryTables.Add(Connection:="TEXT;" & FilePath, Destination:=BS.Cells(2, j + 1))
.TextFileParseType = xlDelimited
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(9, 9, 9, 9, 9, 1, 9, 9, 9, 9)
.Refresh BackgroundQuery:=False
End With
End If
Next j
Next i
Solution 2: Nested Do Loop
Avoiding the "Continue" command, as it is not a VBA command.
For i = 2 To BS.Cells(1, BS.Columns.Count).End(xlToLeft).Column: Do
Item = BS.Cells(1, i).Value
FilePath = Folder & "\" & Item & "1440.CSV"
If Item = "" Or Dir(FilePath) = "" Then Exit Do
j = BS.Cells(2, BS.Columns.Count).End(xlToLeft).Column
If j <> i Then j = i
With BS.QueryTables.Add(Connection:="TEXT;" & FilePath, Destination:=BS.Cells(2, j))
.TextFileParseType = xlDelimited
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(9, 9, 9, 9, 9, 1, 9, 9, 9, 9)
.Refresh BackgroundQuery:=False
End With
Loop While False: Next i
Please, Notice the : Do at the end of the end of the For i.
If one of the following conditions, i.e. Item = "" or Dir(FilePath) = "" is False , then the Do loop is exited. True if the Loop While False: Next i condition for the Do loop is stated.
The two conditions may also be presented as:
For i = 2 To BS.Cells(1, BS.Columns.Count).End(xlToLeft).Column: Do
If Item <> "" Or Dir(FilePath) <> "" Then
'Do something...
Else: Exit Do
End If
Loop While True: Next i
Having the Or condition in the If Item = "" Or Dir(FilePath) = "" Then Exit Do is mandatory as i may be Value <> " ", but the FilePath to the file may be non-existent i.e. Dir(FilePath) = " ", which will spit out an error as the previous I had.
The If j <> i Then j = i in this case is mandatory, as the For i is stated as =2 To, meaning that the loop starts from column 2.
This can be avoided by stating the For i loop as For i = 1 To. However this was the initial loop to get the job done.
Further j can be stated as j = BS.Cells(2, i), obtaining the value of i for a column index.
However, the If j <> i Then j = i statement is advisable for further assurance purposes.
In further search more solutions emerged.
See Solution 3: Nested For Loop with Nested If Statement
[enter link description here][1]I'm trying to search specific words in this text file in order to output it's line content in excel columns. The text file contains multiple sections. I'm able to output the first section of my text file but for some reasons I can't define a loop so I could retrieve every section of the file.
My code so far :
Sub test()
Dim myFile As String, text As String, textline As String, DDC As Integer, DDR As Integer, DDP As Integer, ADC As Integer, i As Integer, SE As Integer, SP As Integer, SG As Integer, j As Integer, v As Integer
myFile = "C:\Users\Seb\Desktop\text2.txt"
Open myFile For Input As #1
Do Until EOF(1)
Line Input #1, textline
text = text & textline
Loop
Close #1
i = 1
DDC = InStr(text, "Date de calcul")
DDR = InStr(text, "Date de retraite")
ADC = InStr(text, "Âge à la date du calcul")
SE = InStr(text, "Service d'emploi")
SP = InStr(text, "Service de participation")
SG = InStr(text, "Salaire gagné")
Cells(i + 1, 1).Value = Mid(text, DDC, 14)
Cells(i + 1, 2).Value = Mid(text, DDC + 36, 10)
Cells(i + 2, 1).Value = Mid(text, DDR, 16)
Cells(i + 2, 2).Value = Mid(text, DDR + 36, 10)
Cells(i + 3, 1).Value = Mid(text, ADC, 23)
Cells(i + 3, 2).Value = Mid(text, ADC + 36, 6)
Cells(i + 4, 1).Value = Mid(text, SE, 16)
Cells(i + 4, 2).Value = Mid(text, SE + 36, 6)
Cells(i + 5, 1).Value = Mid(text, SP, 24)
Cells(i + 5, 2).Value = Mid(text, SP + 36, 6)
For v = 0 To 10
j = v * 228
Cells(v + 7, 1).Value = Mid(text, SG + j, 24) + Mid(text, SG + 64 + j, 10) + "/ " + Mid(text, SG + 77 + j, 10)
Cells(v + 7, 2).Value = Mid(text, SG + 103 + j, 10)
Next v
End Sub
An exemple of my text file is available here: http://txt.do/5j2dq
As I mentioned before, I'm only able to output section 1 in excel. What my code should be in order to retrieve every sections of my text file?
After you have covered each section, simply remove the covered part from your text string, so that in the next iteration e.g. InStr(text, "Date 1") will find the Date 1 line of the next section.
Do While True
DDC = InStr(text, "Date 1")
If DDC = 0 Then
' no more sections - exit loop
Exit Do
End If
DDR = InStr(text, "Date 2")
ADC = InStr(text, "Age")
' ......
Next v
' remove the section that was just handled
text = Mid(text, SG + 30)
Loop
If you bring the TXT file in as Data ► External Data ► From Text, you can set period as an Other delimiter (with Treat consecutive delimiters as one being True).
Sub Import_Text()
Dim c As Long, myFile As String
myFile = "C:\Users\Seb\Desktop\text.txt"
With Worksheets("Sheet9") '<~~set this worksheet reference properly!
With .QueryTables.Add(Connection:="TEXT;" & myFile, _
Destination:=Range("$A$1"))
.Name = "TXT"
.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 = True
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "."
.TextFileColumnDataTypes = Array(1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
'these will cleanup (trim) the results
For c = 1 To 2
With .Columns(c)
.TextToColumns Destination:=.Cells(1), DataType:=xlFixedWidth, _
FieldInfo:=Array(0, 1), TrailingMinusNumbers:=True
End With
Next c
End With
End Sub
There are two final Range.TextToColumns method with the xlFixedWidth option that simply trim off any rogue leading/railing spaces from the results.
My text file contains something like
a , b , c , d
I want to select only b and c
So far I already make macro that can read all data (a,b,c,d)
With ws.QueryTables.Add("TEXT;" & File, ws.Cells(1, 1))
.FieldNames = True
.AdjustColumnWidth = True
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileCommaDelimiter = True
.TextFileColumnDataTypes = columnFormats
.Refresh
End With
What I need to add for selecting b and c only?
Try adding:
.TextFileColumnDataTypes = Array(9, 1, 1, 9)
where 9 stands for skip
I have a macro that uses the get external data option to import a text file. Is there a way that I can prompt the user to select a file in this code or should I take a different approach? I like this approach because I can exclude some columns during the import, but I am open to other options.
With Sheets(1).QueryTables.Add(Connection:= _
"TEXT;C:\Program Files\SubDirectory\ThisIsMyFile.txt" _
, Destination:=Range("$A$1"))
.Name = "ThisIsMyFile"
.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
.TextFileColumnDataTypes = Array(9, 9, 9, 2, 9, 2, 9, 9, 9, 2, 9, 9, 9, 2, 2, 9, 2, 9, 2, 9, 2, _
9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 9, 9, 2, 9, 2, 9, 2, 9, 2 _
, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 9, 9, 9, 9, 2, 9, 9, 9, 2, 9, 2, 9, 9, 9, _
2, 9, 9, 2, 2, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Thanks in advance!
Thanks for the help. I got this code to work:
Dim FileFilter As String
Dim Filename As String
Dim SrcWkb As Workbook
MsgBox "Select file"
FileFilter = "Text Files (*.txt), *.txt"
Filename = Application.GetOpenFilename(FileFilter, 1)
If Filename = "False" Then Exit Sub
With Sheets(1).QueryTables.Add(Connection:= _
"TEXT;" & Filename, Destination:=Range("$A$1"))
.Name = Filename
.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
.TextFileColumnDataTypes = Array(9, 9, 9, 2, 9, 2, 9, 9, 9, 2, 9, 9, 9, 2, 2, 9, 2, 9, 2, 9, 2, _
9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 9, 9, 2, 9, 2, 9, 2, 9, 2 _
, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 9, 9, 9, 9, 2, 9, 9, 9, 2, 9, 2, 9, 9, 9, _
2, 9, 9, 2, 2, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
Something like this should work:
Sub FileName()
fileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If fileToOpen <> False Then QueryTable fileToOpen
End Sub
Sub QueryTable(file As String)
With Sheets(1).QueryTables.Add(Connection:= _
"TEXT;" & file, Destination:=Range("$A$1"))
.Name = "ThisIsMyFile"
.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
.TextFileColumnDataTypes = Array(9, 9, 9, 2, 9, 2, 9, 9, 9, 2, 9, 9, 9, 2, 2, 9, 2, 9, 2, 9, 2, _
9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 9, 9, 2, 9, 2, 9, 2, 9, 2 _
, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 2, 9, 9, 9, 9, 9, 2, 9, 9, 9, 2, 9, 2, 9, 9, 9, _
2, 9, 9, 2, 2, 2)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub