Bacchus
02-04-2022, 12:40 PM
Hello,
I have a problem I have been stumbling over for some time. It is not such a huge issue that it needed solving, but now I've got the itch to finally figure it out and could use some help.
I import several text files using the following macro. This allows me to select a directory and all the text files I wish to import. The files are imported as fixed width and each file is put into its own sheet named after the text file. This works wonderfully except some of the files wont import as fixed width. The entire file contents are imported into column A instead of being broken across columns A-D.
Ignore the commented out line for now.
Sub ImportC()
Application.ScreenUpdating = False
Dim xFilesToOpen As Variant
Dim I As Integer
Dim xWb As Workbook
Dim xTempWb As Workbook
On Error GoTo ErrHandler
xFilesToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt", , "3D", , True)
If TypeName(xFilesToOpen) = "Boolean" Then
MsgBox "No files were selected", , "3D"
GoTo ExitHandler
End If
I = 1
Set xTempWb = Workbooks.Open(xFilesToOpen(I))
xTempWb.Sheets(1).Copy
Set xWb = Application.ActiveWorkbook
xTempWb.Close False
xWb.Worksheets(I).Columns("A:A").TextToColumns _
Destination:=Range("A1"), _
DataType:=xlFixedWidth, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, _
Semicolon:=False, _
Comma:=False, _
Space:=False, _
Other:=False
'fieldinfo:=Array(Array(0, 1), Array(34, 1), Array(23, 1), Array(23, 1))
Do While I < UBound(xFilesToOpen)
I = I + 1
Set xTempWb = Workbooks.Open(xFilesToOpen(I))
With xWb
xTempWb.Sheets(1).Move after:=.Sheets(.Sheets.Count)
.Worksheets(I).Columns("A:A").TextToColumns _
Destination:=Range("A1"), _
DataType:=xlFixedWidth, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, _
Semicolon:=False, _
Comma:=False, _
Space:=False, _
Other:=False
'fieldinfo:=Array(Array(0, 1), Array(34, 1), Array(23, 1), Array(23, 1))
End With
Loop
ExitHandler:
Set xWb = Nothing
Set xTempWb = Nothing
Exit Sub
ErrHandler:
MsgBox Err.Description, , "3D"
Resume ExitHandler
Application.ScreenUpdating = True
End Sub
If a file fails to import correctly after running that above macro, I'll manually import the file. I recorded the process and the code is as follows:
With ActiveSheet.QueryTables.Add(Connection:="TEXT;filepath\textfile.txt", Destination:=Range("$A$1"))
.CommandType = 0
.Name = "filename"
.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 = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(33, 24, 24)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
I have tried adding the fieldinfo parameter to the TextToColumns statement above (it's commented out) to ensure all the imports are set with the correct fixed widths. It works but when I compare the results of the macro with and without that line of code, the imports don't look alike. The column widths are messed up.
So basically the first macro works for most of the files I want to import. When it does not, I manually import the file. I would like to find a solution where each file is imported correctly without manual intervention. I'm not sure if rewriting the macro replacing texttocolumns with querytable makes sense, or how I should go about that?
Unfortunately I cant really provide a text file example because of the data and formatting involved with how they are created.
Thanks for any help
cheers
I have a problem I have been stumbling over for some time. It is not such a huge issue that it needed solving, but now I've got the itch to finally figure it out and could use some help.
I import several text files using the following macro. This allows me to select a directory and all the text files I wish to import. The files are imported as fixed width and each file is put into its own sheet named after the text file. This works wonderfully except some of the files wont import as fixed width. The entire file contents are imported into column A instead of being broken across columns A-D.
Ignore the commented out line for now.
Sub ImportC()
Application.ScreenUpdating = False
Dim xFilesToOpen As Variant
Dim I As Integer
Dim xWb As Workbook
Dim xTempWb As Workbook
On Error GoTo ErrHandler
xFilesToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt", , "3D", , True)
If TypeName(xFilesToOpen) = "Boolean" Then
MsgBox "No files were selected", , "3D"
GoTo ExitHandler
End If
I = 1
Set xTempWb = Workbooks.Open(xFilesToOpen(I))
xTempWb.Sheets(1).Copy
Set xWb = Application.ActiveWorkbook
xTempWb.Close False
xWb.Worksheets(I).Columns("A:A").TextToColumns _
Destination:=Range("A1"), _
DataType:=xlFixedWidth, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, _
Semicolon:=False, _
Comma:=False, _
Space:=False, _
Other:=False
'fieldinfo:=Array(Array(0, 1), Array(34, 1), Array(23, 1), Array(23, 1))
Do While I < UBound(xFilesToOpen)
I = I + 1
Set xTempWb = Workbooks.Open(xFilesToOpen(I))
With xWb
xTempWb.Sheets(1).Move after:=.Sheets(.Sheets.Count)
.Worksheets(I).Columns("A:A").TextToColumns _
Destination:=Range("A1"), _
DataType:=xlFixedWidth, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, _
Semicolon:=False, _
Comma:=False, _
Space:=False, _
Other:=False
'fieldinfo:=Array(Array(0, 1), Array(34, 1), Array(23, 1), Array(23, 1))
End With
Loop
ExitHandler:
Set xWb = Nothing
Set xTempWb = Nothing
Exit Sub
ErrHandler:
MsgBox Err.Description, , "3D"
Resume ExitHandler
Application.ScreenUpdating = True
End Sub
If a file fails to import correctly after running that above macro, I'll manually import the file. I recorded the process and the code is as follows:
With ActiveSheet.QueryTables.Add(Connection:="TEXT;filepath\textfile.txt", Destination:=Range("$A$1"))
.CommandType = 0
.Name = "filename"
.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 = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1)
.TextFileFixedColumnWidths = Array(33, 24, 24)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
I have tried adding the fieldinfo parameter to the TextToColumns statement above (it's commented out) to ensure all the imports are set with the correct fixed widths. It works but when I compare the results of the macro with and without that line of code, the imports don't look alike. The column widths are messed up.
So basically the first macro works for most of the files I want to import. When it does not, I manually import the file. I would like to find a solution where each file is imported correctly without manual intervention. I'm not sure if rewriting the macro replacing texttocolumns with querytable makes sense, or how I should go about that?
Unfortunately I cant really provide a text file example because of the data and formatting involved with how they are created.
Thanks for any help
cheers