Hi there!
Been searching forever to get some VBA code to do what I need! I think I'm almost there...
Scenario: I have many folders labelled with an ID for the folder name. In each of these folders are a series of .txt files with pipeline delimited data that belongs to that ID number/folder name.
The code below works, in that I am able to select one of the folders (by entering the path name in the code) and pull all of the data from the .txt files into separate sheets in a workbook. Great!
However, I now need to develop this code so that I can:
1. Write in column A, for all sheets, the folder name that the .txt files come from (in the example below, to show the value "1028" in column A next to each row).
2. Have the code go through all folders so that I don't have to keep changing the file path name in the script (i.e. run for all folders in the "Ideas" folder).
I don't know VBA at all really...thought I could just add a line to write the filepath or something, but no luck.
Please help!
Current code:
<code style="margin: 0px; padding: 0px; border: 0px; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, sans-serif; white-space: inherit;">Sub EXTRACT1()
Dim idx As Integer
Dim fpath As String
Dim fname As String
idx = 0
fpath = "C:\Users\Adam\Desktop\Ideas\1028\"
fname = Dir(fpath & "*.txt")
While (Len(fname) > 0)
idx = idx + 1
Sheets.Add.Name = fname
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</code>
Been searching forever to get some VBA code to do what I need! I think I'm almost there...
Scenario: I have many folders labelled with an ID for the folder name. In each of these folders are a series of .txt files with pipeline delimited data that belongs to that ID number/folder name.
The code below works, in that I am able to select one of the folders (by entering the path name in the code) and pull all of the data from the .txt files into separate sheets in a workbook. Great!
However, I now need to develop this code so that I can:
1. Write in column A, for all sheets, the folder name that the .txt files come from (in the example below, to show the value "1028" in column A next to each row).
2. Have the code go through all folders so that I don't have to keep changing the file path name in the script (i.e. run for all folders in the "Ideas" folder).
I don't know VBA at all really...thought I could just add a line to write the filepath or something, but no luck.
Please help!
Current code:
<code style="margin: 0px; padding: 0px; border: 0px; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, sans-serif; white-space: inherit;">Sub EXTRACT1()
Dim idx As Integer
Dim fpath As String
Dim fname As String
idx = 0
fpath = "C:\Users\Adam\Desktop\Ideas\1028\"
fname = Dir(fpath & "*.txt")
While (Len(fname) > 0)
idx = idx + 1
Sheets.Add.Name = fname
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</code>
