multiple text to excel + filename

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

[vba]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[/vba]

Does anyone have any ideas?

I'm new to VBA and am lost with this problem

Hi, hope this will help You :hi: Pavel

[vba]
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
Rows("1:1").Insert Shift:=xlDown
ActiveSheet.Cells(1, 1).Value = FileName

With ActiveSheet
For i = LBound(FileName) + 1 To UBound(FileName)
ActiveSheet.Cells(1, i).Value = FileName(i)
With .QueryTables.Add(Connection:="TEXT;" & (FileName(i)), _
Destination:=ActiveSheet.Cells(2, 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:\01\")
ActiveWorkbook.SaveAs ("textarea.xls"), xlWorkbookNormal
MsgBox "Converted " & i - 1 & " files"
End Sub
[/vba]

Hi Pavel,

Thanks for your help

Ok that will place the 1st filename selected and its file path into A1 but not the others

What I am after is being able to place the file name (not path if possible) and also be able to carry filename into A1, filename into B1 etc in a loop

HTH, example:

[vba]
OnlyFileName = Replace(PathAndFileName,Path,"")
[/vba]

Try this for A1
[vba]
ActiveSheet.Cells(1, 1).Value = Replace(FileName(1), "C:\01\", "")
[/vba]

Try this for B1 ..
[vba]
ActiveSheet.Cells(1, i).Value = Replace(FileName(i),"C:\01\","")
[/vba]

Hi mate, is there a way to do the following with that string

- only show the filename without the extension
- setup a loop so it automatically logs it for any file?

Sorry if this sounds stupid but I'm new to VBA

Its all good managed to work my way around it thanks again Pavel

Hi Sprayzen,

me is happy to see it is working,

good luck and happy day :hi:

Pavel Humenuk