VBA to import TXT as text into Excel

[Dampa88]

Dears,

I'm trying to build a macro to import in Excel a TXT file as text.

In the TXT file I normally have numbers with more that 16 digits so if I copy and paste them in Excel I need to make sure that the cell format is "text".
If not, those big numbers are loosing the last digits.

I tried a couple of macros, but when the TXT is opened automatically the numbers get converted. When they are pasted into the final sheet the result is already corrupted.

Below a TXT example:
9990600331568537
TEST1
54008520005491689
TEST2

In Excel I get:
9.9906E+15
TEST1
5.40085E+16
TEST2

Macros tested are:

Sub Macro1()

    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\MyFile.txt", Destination:=Range("$H$5") _
        )
        .Name = "Sample"
        .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 = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    
End Sub

Sub Macro2()

    Dim wbI As Workbook, wbO As Workbook
    Dim wsI As Worksheet
    
    Set wbI = ThisWorkbook
    Set wsI = wbI.Sheets("Test")
    Set wbO = Workbooks.Open("C:\MyFile.txt")
    wbO.Sheets(1).Cells.Copy wsI.Cells
    wbO.Close SaveChanges:=False
End Sub

Do you have any advice to solve this problem?

Thanks a lot!

 

[Joe4]

I think your issue may be with this line here:

.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)

That says you are importing 6 fields, and they are all set to a field type of "General" (represented by a "1").
It looks like the "Text" type uses a value of "2" (see: XlColumnDataType enumeration (Excel))

So you need to identify which of the 6 fields this value is found in and update that value from 1 to 2.

 

[JEC]

Sub jec()
c00 = "C:\Users\xxx\Downloads\testtenn.txt"
  With CreateObject("scripting.filesystemobject")
    a = Split(.opentextfile(c00).readall, vbCrLf)
    With ThisWorkbook.Sheets(1).Cells(1, 1).Resize(UBound(a))
      .NumberFormat = "@"
      .Value = Application.Transpose(a)
    End With
  End With
End Sub

 

[Dampa88]

I think your issue may be with this line here:

.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)

That says you are importing 6 fields, and they are all set to a field type of "General" (represented by a "1").
It looks like the "Text" type uses a value of "2" (see: XlColumnDataType enumeration (Excel))

So you need to identify which of the 6 fields this value is found in and update that value from 1 to 2.

Thanks for the suggestion, I resolved by putting 2 instead of 1 and it worked.

Sub jec()
c00 = "C:\Users\xxx\Downloads\testtenn.txt"
  With CreateObject("scripting.filesystemobject")
    a = Split(.opentextfile(c00).readall, vbCrLf)
    With ThisWorkbook.Sheets(1).Cells(1, 1).Resize(UBound(a))
      .NumberFormat = "@"
      .Value = Application.Transpose(a)
    End With
  End With
End Sub

Thanks for the code. This ones works however I'm facing the problems:
a) the last row is excluded, I get just the first 3 lines
b) it's importing data from the cell A1 of the first sheet, while I need to select a specific sheet/cell.

Do you have some suggestions to fix this? This code seems faster and it does not create a query connection.

Thanks both,
D

 

[Zyndstoff]

In your first code, replace

.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)

with

.TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2)

Does that work?

Oooops, sorry - has been posted already.

 

[JEC]

Change .resize(ubound(a))

To:
.resize(ubound(a)+1)

 

[Dampa88]

Change .resize(ubound(a))

To:
.resize(ubound(a)+1)

Thanks a lot. I'm going with this option.
I have also amended below part to save data from a specific cell.

    With ThisWorkbook.Sheets("MySheet").Cells(5, 8).Resize(UBound(a) + 1)

 

[Dampa88]

Sub jec()
c00 = "C:\Users\xxx\Downloads\testtenn.txt"
  With CreateObject("scripting.filesystemobject")
    a = Split(.opentextfile(c00).readall, vbCrLf)
    With ThisWorkbook.Sheets(1).Cells(1, 1).Resize(UBound(a))
      .NumberFormat = "@"
      .Value = Application.Transpose(a)
    End With
  End With
End Sub

Hi,

Is there any way to loop this code for all the txt files of a folder? I wouldn't need to merge the file as I need to implement another code after that.
After thr first run of the macro, I would need to run the same for all the others files.
At the moment I'm thinking to use a dialog box to open each file, but surely there's a quicker way.

Thanks,
D

 

[JEC]

Is possible but where to paste the data of all files.
Next or below the last pasted data?

 

[JEC]

Something like:

Sub jec()
 Dim c00 As String, fl As Variant, a As Variant
 c00 = "C:\Users\xx\Downloads\"

  With CreateObject("scripting.filesystemobject")
     For Each fl In .getfolder(c00).Files
       If .GetExtensionName(fl) = "txt" Then
           a = Split(.opentextfile(fl).readall, vbCrLf)
           With ThisWorkbook.Sheets(1).Range("A" & Rows.Count).End(xlUp).Offset(2).Resize(UBound(a))
             .NumberFormat = "@"
             .Value = Application.Transpose(a)
           End With
        End If
      Next
  End With
End Sub