Convert numbers in imported txt file data to text

Question

I am reusing code Import Multiple text files into workbook where worksheet name matches text file name

This code is creating multiple worksheets and importing pipe delimited data into individual columns.

I need all the cells to be set to Text qualified before it does the text to columns.

Basically I want all the columns to be in text format instead of default General as the 16 digit numbers that I have in my file are getting messed up with General format.

I did try to put below lines but it changes the format after text to column is completed.

cells.select
Selection.NumberFormat = "@"

Here is the code that I am using

Sub Extract()
Dim FilesToOpen
Dim x As Integer
Dim wkbAll As Workbook
Dim sDelimiter As String
On Error GoTo ErrHandler
Application.ScreenUpdating = False

sDelimiter = "|"

FilesToOpen = Application.GetOpenFilename _
    (FileFilter:="Text Files (*.txt), *.txt", _
    MultiSelect:=True, Title:="Text Files to Open")

If TypeName(FilesToOpen) = "Boolean" Then
    MsgBox "No Files were selected"
    GoTo ExitHandler
End If


Set wkbAll = Application.ActiveWorkbook
x = 1
With Workbooks.Open(Filename:=FilesToOpen(x))
    .Worksheets(1).Columns("A:A").TextToColumns _
        Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
        Tab:=False, Semicolon:=False, Comma:=False, Space:=False, _
        Other:=True, OtherChar:="|"
    .Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    .Close False
End With

x = x + 1

While x <= UBound(FilesToOpen)
    With Workbooks.Open(Filename:=FilesToOpen(x))
        .Worksheets(1).Columns("A:A").TextToColumns _
            Destination:=Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=False, _
            Tab:=False, Semicolon:=False, _
            Comma:=False, Space:=False, _
            Other:=True, OtherChar:=sDelimiter
        .Sheets(1).Move  After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

    End With
    x = x + 1
Wend

wkbAll.Save
ExitHandler:
Application.ScreenUpdating = True
Set wkbAll = Nothing
Exit Sub

ErrHandler:
MsgBox Err.Description
Resume ExitHandler

End Sub

Answer 1

Not the permanent solution but I added below change which looks like resolved my problem. Since the longest record in one of my file has 45 cells I auto recorded below Macro and appended to my code after OtherChar:="|" and now it is working as I wanted.

OtherChar:="|", FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, _
    2), Array(6, 2), Array(7, 2), Array(8, 2), Array(9, 2), Array(10, 2), Array(11, 2), Array(12 _
    , 2), Array(13, 2), Array(14, 2), Array(15, 2), Array(16, 2), Array(17, 2), Array(18, 2), _
    Array(19, 2), Array(20, 2), Array(21, 2), Array(22, 2), Array(23, 2), Array(24, 2), Array( _
    25, 2), Array(26, 2), Array(27, 2), Array(28, 2), Array(29, 2), Array(30, 2), Array(31, 2), _
    Array(32, 2), Array(33, 2), Array(34, 2), Array(35, 2), Array(36, 2), Array(37, 2), Array( _
    38, 2), Array(39, 2), Array(40, 2), Array(41, 2), Array(42, 2), Array(43, 2), Array(44, 2), _
    Array(45, 2)), TrailingMinusNumbers:=True

Answer 2

Try this (I haven't). It (hopefully) sets all cells in the sheet to text. With see commented section for the addition.

Sub Extract()
Dim FilesToOpen
Dim x As Integer
Dim wkbAll As Workbook
Dim sDelimiter As String
On Error GoTo ErrHandler
Application.ScreenUpdating = False

sDelimiter = "|"

FilesToOpen = Application.GetOpenFilename _
    (FileFilter:="Text Files (*.txt), *.txt", _
    MultiSelect:=True, Title:="Text Files to Open")

If TypeName(FilesToOpen) = "Boolean" Then
    MsgBox "No Files were selected"
    GoTo ExitHandler
End If


Set wkbAll = Application.ActiveWorkbook
x = 1
With Workbooks.Open(Filename:=FilesToOpen(x))
' ---------------------------------------------------
    .Worksheets(1).Cells.NumberFormat = "@"
' ---------------------------------------------------
    .Worksheets(1).Columns("A:A").TextToColumns _
        Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
        Tab:=False, Semicolon:=False, Comma:=False, Space:=False, _
        Other:=True, OtherChar:="|"
    .Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    .Close False
End With

x = x + 1

While x <= UBound(FilesToOpen)
    With Workbooks.Open(Filename:=FilesToOpen(x))
        .Worksheets(1).Columns("A:A").TextToColumns _
            Destination:=Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=False, _
            Tab:=False, Semicolon:=False, _
            Comma:=False, Space:=False, _
            Other:=True, OtherChar:=sDelimiter
        .Sheets(1).Move  After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

    End With
    x = x + 1
Wend

wkbAll.Save
ExitHandler:
Application.ScreenUpdating = True
Set wkbAll = Nothing
Exit Sub

ErrHandler:
MsgBox Err.Description
Resume ExitHandler

End Sub