Set the cell format to text in excel before importing

Question

i am importing multiple text files in excel using the Macro given at this site

it is working but say for example u have data as 0010 it is changing it to 10 i tried to modify the code by adding Destination:=Range("A1").NumberFormatLocal = "@" in the script but it is giving error texttocoloums method of range class failed

here is the original code

Sub CombineTextFiles()
    Dim FilesToOpen
    Dim x As Integer
    Dim wkbAll As Workbook
    Dim wkbTemp 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

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

    While x <= UBound(FilesToOpen)
        Set wkbTemp = Workbooks.Open(FileName:=FilesToOpen(x))
        With wkbAll
            wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)
            .Worksheets(x).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
        End With
        x = x + 1
    Wend

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

ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub

Answer 1

You could also import with Python. You could do this : (put your directory name containing all your the text files in mypath between the ' ''s)

Your files (csv's or .txt files) are read into dataframes, significantly as dtype='object' , which is the KEY here to preserving their formatting fully and keeping leading 000's in ALL txt source files when using the method.

I know there are 10000 other ways to do it much more elegantly (such as here and elsewhere) but I'm super happy I did it like this using Python as well.

from os import walk
import pandas as pd
from pathlib import Path

mypath=r'C:\Users\user\Documents\Data_Souce4\New Folder (2)'

f = []
df=[]
for (dirpath, dirnames, filenames) in walk(mypath):
    f.extend(filenames)
    #print(f)
    #print(f[2])

    for f in f:

        ab=print(mypath+"\\"+f) #you an remove this - was just for me to see whats going on

        str_path = mypath+"\\"+f
        path=Path(str_path)
        print(path)

        df = pd.read_csv(path, dtype=('object'), sep=r'\\t') 

        df.to_excel(mypath + "\\" + f + '.xls', index=True, header=True)


    break

Answer 2

Consider the following code. Run it , it works, does what you want. Might be a bit slower (if you don't have any blank lines in any of your notepad files you can remove If Len(lineData) > 0 Then & the end if. to speed it up again) but I think it always worth keeping those lines in, incase if you do have empty rows in any of your notepad files.

I was also going to refer you to Python which can convert .txt files to Excel, keep the formatting without any extra work, simpler. Pretty native of it to do so. So If you have python it might be better to use that to convert your notepad files to excel en-masse (they are short scripts no matter which method you use there), but in VBA I've refered to this for keeping the formatting & leading zeros, and this to create the structure to import my files.

Sub doIt6()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim InputTextFile As Variant
Dim SourceDataFolder As String, OutputDataFolder As String
SourceDataFolder = "C:\Users\User\Documents\Source_Data2 - Copy"
OutputDataFolder = "C:\Users\User\Documents\Output_Data - Copy"
'Loop through each text file in source folder
InputTextFile = Dir(SourceDataFolder & "\*.txt")
While InputTextFile <> ""
Workbooks.OpenText FileName:=SourceDataFolder & "\" & InputTextFile, DataType:=xlDelimited, Tab:=True

    Dim myFileName As Variant
    Dim myFileNames As Variant
    Dim wb As Workbook

    'myFileNames = Application.GetOpenFilename( _
     '   filefilter:="Excel Files,*.xl*;*.xm*", _
      '  title:="Select Excel File to Open", _
       ' MultiSelect:=True)

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

    If Not IsArray(myFileNames) Then Exit Sub

    For Each myFileName In myFileNames
        Set wb = Workbooks.Open(myFileName, False, False)
        'StandaloneReportEdit()'Sub to very thoroughly edit reports

Dim fn As Integer
    Dim MyData As String
    Dim lineData As String, strData() As String, myFile As String
    Dim i As Long, rng As Range
'Workbooks.OpenText Filename:=SourceDataFolder & "\" & InputTextFile, DataType:=xlDelimited, Tab:=True

    Set rng = Range("A1")

    ' Lets not rely on Magic Numbers
    fn = FreeFile
    Open myFileName For Input As #fn
    i = 1
    Do While Not EOF(fn)
        Line Input #fn, lineData
            If Len(lineData) > 0 Then
                strData = Split(lineData, "|")
                rng.Cells(i, 1).Resize(1, UBound(strData) + 1) = strData
            End If
        i = i + 1
        Loop
    Close #fn

    ActiveWorkbook.SaveAs FileName:=OutputDataFolder & "\" & Replace(ActiveWorkbook.Name, ".txt", ".xlsx"), FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close
InputTextFile = Dir


    Next


'Save each output file in output folder / maybe put this inside the loop
'ActiveWorkbook.SaveAs FileName:=OutputDataFolder & "\" & Replace(ActiveWorkbook.Name, ".txt", ".xlsx"), FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
'ActiveWorkbook.Close
'InputTextFile = Dir
Wend
End Sub

*note: I am at work, (day job). have lost many urls I was referring to (they are in chrome history but with no time to check on any others, & I must get on with my work) to do this, but can I re-edit this post and dig them up for you tonight if you need.

Does this answer your question ?