PDA

View Full Version : multiple text to excel + filename



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

Sprayzen
06-30-2009, 01:55 PM
Does anyone have any ideas?

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

hardlife
06-30-2009, 02:49 PM
Hi, hope this will help You :hi: Pavel


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

Sprayzen
06-30-2009, 08:55 PM
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

hardlife
07-01-2009, 01:51 PM
HTH, example:


OnlyFileName = Replace(PathAndFileName,Path,"")


Try this for A1

ActiveSheet.Cells(1, 1).Value = Replace(FileName(1), "C:\01\", "")


Try this for B1 ..

ActiveSheet.Cells(1, i).Value = Replace(FileName(i),"C:\01\","")

Sprayzen
07-02-2009, 05:18 AM
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

Sprayzen
07-02-2009, 07:10 AM
Its all good managed to work my way around it thanks again Pavel

hardlife
07-02-2009, 10:49 AM
Hi Sprayzen,

me is happy to see it is working,

good luck and happy day :hi:

Pavel Humenuk