Import contents of many text files into a single XLS Worksheet

[murphyw]

I need to import text from several text files into successive columns in a single XLS worksheet. Thread707-1444974 of this forum provided a solution for opening many text files and saving them in separate xls Workbook files. I modified that code below to enable it to use part of the file path as the single output file name that will be used to save the concatonation of the contents of many text files, but I have been unable to figure out how to insert the contents of multiple text files into successive columns of a single worksheet. The formatting of the contents of my text files is such that my code below appropriately places all of the imported text into a Column A. I would like the text from the second .txt file to go into Column B of the same worksheet, the text from the third .txt file to go into Column C, etc. (but not into separate worksheets in separate workbooks). The top cell used to paste the contents of each of the text files should begin in the same row of the single Excel worksheet.

The problem is with the following code:

Workbooks.OpenText FileName:=FileName(i), StartRow:=73, DataType:=xlDelimited, Tab:=True

How can I change my code to fix this problem?

Thank you,
murphyw

------------------------------------------

Option Explicit

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


' File filters
Filter = "Text Files (*.txt),*.txt,"
' Set default filter to *.txt
FilterIndex = 1

' Set the title of the dialog
Title = "Choose the files you want to open"

' Choose the drive, path, and output file prefix
Path = ThisWorkbook.Path
OutputFile = Split(Path, "\")

Drive = Left(Path, 1)
ChDrive (Drive)
ChDir (Path)

With Application
' Set the array of file names to the selected filenames (allow multiple)
FileName = .GetOpenFilename(Filter, FilterIndex, Title, , True)
' Reset the initial drive / path
ChDrive (Left(.DefaultFilePath, 1))
ChDir (.DefaultFilePath)
End With


' Exit when cancelled
If Not IsArray(FileName) Then
MsgBox "No file was selected."
Exit Sub
End If

' Open files
For i = LBound(FileName) To UBound(FileName)
msg = msg & FileName(i) & vbCrLf
Workbooks.OpenText FileName:=FileName(i), StartRow:=73, DataType:=xlDelimited, Tab:=True
' ActiveWorkbook.SaveAs Replace$(FileName(i), ".txt", ".xls"), xlWorkbookNormal
' ActiveWorkbook.Close
Next i
MsgBox msg, vbInformation, "Converted " & i - 1 & " files"

ChDir (Path)
ActiveWorkbook.SaveAs (OutputFile(UBound(OutputFile)) & ".xls"), xlWorkbookNormal

ActiveWorkbook.Close

End Sub

 

[SkipVought]

Where is your macro that IMPORTS into a sheet?

I asked you to macro record that and post.

Skip,
[sub]
Did you hear what happened when the OO programmer lost his library?...
He's now living in OBJECT poverty![/sub]

 

[murphyw]

Skip,

I am sorry but I didn't understand what you were asking for because I was focused on the macro I pasted in my original post to this thread that is embedded in the Excel spreadsheet that I didn't create using the record macro function. This current posting includes a macro I created using the record macro function in Excel. However, in my estimation the macro I recorded and pasted below does not come as close to solving the problem as the one I included in my original posting to this thread. My reasoning is that I am trying to convert over 100 text files from the same directory automatically into a single Worksheet and my below recorded macro manually selects only two of the 100+ files that I manually clicked on. I don't know how to replicate via a recorded macro the automatic opening and importing of 100+ files. Perhaps I still don't understand what you are asking for. Does the below recorded macro answer your question or are you asking me to do something else? Thank you.
Bill

Sub Input_Save_Two_Files()
'
' Input_Save_Two_Files Macro
'

'
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\Bill\Documents\DTA\XML Cplus JAVA Satellite\Text\File_First_Input.txt" _
, Destination:=Range("$A$1"))
.Name = "File_First_Input"
.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
Range("B1").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\Bill\Documents\DTA\XML Cplus JAVA Satellite\Text\File_Second_Input.txt" _
, Destination:=Range("$B$1"))
.Name = "File_Second_Input"
.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
ActiveWorkbook.Save
ChDir "C:\Users\Bill\Documents\DTA\XML Cplus JAVA Satellite\Text"
ActiveWorkbook.SaveAs FileName:= _
"C:\Users\Bill\Documents\DTA\XML Cplus JAVA Satellite\Text\Text.xls", _
FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub

 

[SkipVought]

"...the macro I recorded and pasted below does not come as close to solving the problem as the one I included in my original posting to this thread"

Your original macro opens a text file as a workbook. 100 workbooks? Is that what you want? I understood that you wanted to know, "how to insert the contents of multiple text files into successive columns of a single worksheet"

Frankly, it comes very close. You only needed to record opening ONE.

Now some questions. Do you want to inport all the text files in one FOLDER? All the text files in a LIST? How do w know what they are and when we are done?

Skip,
[sub]
Did you hear what happened when the OO programmer lost his library?...
He's now living in OBJECT poverty![/sub]

 

[SkipVought]

Here's the basic code, sans the method to assign each filename, which we are waiting on...

Sub Input_Files()
    Dim sPath As String, sDB As String
    
    sPath = "C:\Users\Bill\Documents\DTA\XML Cplus JAVA Satellite\Text"
'
    With ActiveSheet
        For i = 1 To SomeLimit
            sDB = ""    'assign the file name THIS IS THE NEXT QUESTION
            With .QueryTables.Add(Connection:= _
                "TEXT;" & sPath & "\" & sDB & ".txt" _
                , Destination:=ActiveSheet.Cells(1, i))
                .Name = sDB
                .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
End Sub

Skip,
[sub]
Did you hear what happened when the OO programmer lost his library?...
He's now living in OBJECT poverty![/sub]

 

[murphyw]

Skip,

You have good insights and questions. My code opens 100 workbooks, which I do not want to do. You are correct that I want to insert the contents of multiple text files into successive columns of a single worksheet. I answered your three questions below.

Do you want to inport all the text files in one FOLDER?

Yes. The contents of every file from a single folder needs to be pasted into a single worksheet. The format of the files is such that when the contents are pasted into successive columns of a worksheet that the rows contain like items (for example one row will contain names). I will later use the macro in another folder to paste the contents of every file contained in that folder into a different single worksheet.

All the text files in a LIST?

No, the file names are not contained in a list. Instead, they are contained in a folder that only contains files whose contents need to be pasted into the columns of a single worksheet.

How do we know what they are and when we are done?

Every file in the folder will be pasted. We are done when the macro has iterated through every file in the folder and pasted its contents into a separate comumn in the spreadsheet.

Thank you,
Bill

 

[murphyw]

Skip,

I combined the two macros to create the following solution that works.
Thanks,
Bill


Option Explicit

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


' File filters
Filter = "Text Files (*.txt),*.txt,"
' Set default filter to *.txt
FilterIndex = 1

' Set the title of the dialog
Title = "Choose the files you want to open"

' Choose the drive, path, and output file prefix
Path = ThisWorkbook.Path
OutputFile = Split(Path, "\")

Drive = Left(Path, 1)
ChDrive (Drive)
ChDir (Path)

With Application
' Set the array of file names to the selected filenames (allow multiple)
FileName = .GetOpenFilename(Filter, FilterIndex, Title, , True)
' Reset the initial drive / path
ChDrive (Left(.DefaultFilePath, 1))
ChDir (.DefaultFilePath)
End With

' Exit when cancelled
If Not IsArray(FileName) Then
MsgBox "No file was selected."
Exit Sub
End If

' Open files and paste into Worksheet
Workbooks.OpenText FileName:=FileName(LBound(FileName)), DataType:=xlDelimited, Tab:=True
With ActiveSheet
For i = LBound(FileName) + 1 To UBound(FileName)
' msg = msg & FileName(i) & vbCrLf

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 (Path)
ActiveWorkbook.SaveAs (OutputFile(UBound(OutputFile)) & ".xls"), xlWorkbookNormal

ActiveWorkbook.Close

' MsgBox msg, vbInformation, "Converted " & i - 1 & " files"
MsgBox "Converted " & i - 1 & " files"

End Sub