Sprayzen
06-29-2009, 08:35 PM
Hi guys,
the script attached imports multiple text files into a single worksheet (not multiple) which works fine. Textfile1 sends data to column A, Textfile2 sends data to column B and so forth (many rows of data)
Now the only problem I have is that I need to know which columns output is associated to which file since no column is labled with the filename (Textfile1,Textfile2 etc)
How do I go about putting the filename (Textfile1,Textfile2 etc) into Row1,2,etc assigned to match the column in which the data pulled from the textfiles?
Any help would be appreciated
Sub Text_file_convert()
Dim Filter As String, Title As String, msg As String
Dim i As Integer, FilterIndex As Integer
Dim FileName As Variant
Dim Path As String
Dim Drive As String
Dim OutputFile() As String
Filter = "Text Files (*.txt),*.txt,"
FilterIndex = 1
Title = "Choose the files you want to open"
Path = ThisWorkbook.Path
OutputFile = Split(Path, "\")
Drive = Left("C:\Temp\", 1)
ChDrive (Drive)
ChDir ("C:\Temp\")
With Application
FileName = .GetOpenFilename(Filter, FilterIndex, Title, , True)
ChDrive (Left(.DefaultFilePath, 1))
ChDir (.DefaultFilePath)
End With
If Not IsArray(FileName) Then
MsgBox "No file was selected."
Exit Sub
End If
Workbooks.OpenText FileName:=FileName(LBound(FileName)), DataType:=xlDelimited, Tab:=True
With ActiveSheet
For i = LBound(FileName) + 1 To UBound(FileName)
With .QueryTables.Add(Connection:="TEXT;" & (FileName(i)), _
Destination:=ActiveSheet.Cells(1, i))
.Name = FileName(i)
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.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
Next
End With
ChDir ("C:\Temp\")
ActiveWorkbook.SaveAs ("textarea.xls"), xlWorkbookNormal
MsgBox "Converted " & i - 1 & " files"
End Sub
the script attached imports multiple text files into a single worksheet (not multiple) which works fine. Textfile1 sends data to column A, Textfile2 sends data to column B and so forth (many rows of data)
Now the only problem I have is that I need to know which columns output is associated to which file since no column is labled with the filename (Textfile1,Textfile2 etc)
How do I go about putting the filename (Textfile1,Textfile2 etc) into Row1,2,etc assigned to match the column in which the data pulled from the textfiles?
Any help would be appreciated
Sub Text_file_convert()
Dim Filter As String, Title As String, msg As String
Dim i As Integer, FilterIndex As Integer
Dim FileName As Variant
Dim Path As String
Dim Drive As String
Dim OutputFile() As String
Filter = "Text Files (*.txt),*.txt,"
FilterIndex = 1
Title = "Choose the files you want to open"
Path = ThisWorkbook.Path
OutputFile = Split(Path, "\")
Drive = Left("C:\Temp\", 1)
ChDrive (Drive)
ChDir ("C:\Temp\")
With Application
FileName = .GetOpenFilename(Filter, FilterIndex, Title, , True)
ChDrive (Left(.DefaultFilePath, 1))
ChDir (.DefaultFilePath)
End With
If Not IsArray(FileName) Then
MsgBox "No file was selected."
Exit Sub
End If
Workbooks.OpenText FileName:=FileName(LBound(FileName)), DataType:=xlDelimited, Tab:=True
With ActiveSheet
For i = LBound(FileName) + 1 To UBound(FileName)
With .QueryTables.Add(Connection:="TEXT;" & (FileName(i)), _
Destination:=ActiveSheet.Cells(1, i))
.Name = FileName(i)
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.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
Next
End With
ChDir ("C:\Temp\")
ActiveWorkbook.SaveAs ("textarea.xls"), xlWorkbookNormal
MsgBox "Converted " & i - 1 & " files"
End Sub