How to get all contents from .TXT file maintaining leading "0"? - excel

Question

I have this code
Dim FileToOpen As Variant
Dim OpenBook As Workbook
FileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)
OpenBook.Sheets(1).UsedRange.Select
Selection.NumberFormat = "#"
OpenBook.Sheets(1).UsedRange.Copy
ThisWorkbook.Worksheets("BOM").Range("C1").PasteSpecial xlPasteValues
OpenBook.Close False
End If
Which is how I tried to automate manual actions of:
Opening a .txt file
Ctrl + a
Ctrl + c
Pasting it in my workbook via VBA code which is irrelevant in this case.
In the end I end up with this kind of table (main workbook in the image below has .NumberFormat = "#"):
https://i.stack.imgur.com/98tiC.png
But when I run it with the code above - I end up with:
https://i.stack.imgur.com/bJahk.png
Ignore the column titles in the row 1.
The problem I faced is that this code I have above, opens .txt file contents with already lost leading "0" in a temporary excel workbook from where it then copies them to my active workbook.
I'm wondering if there's any ways around it to get what I am looking to get done i.e. properly automating the sequence of manual actions listed above via VBA code displaying a search message box as it does now and then me choosing a .txt file I need and getting all the contents from it to my active workbook while maintaining all leading zeros (the number of zeroes and length of strings may vary so no solutions of adding them back in again won't be what I'm looking for)

Answer 1

The issue that you have is that as soon as excel gets hold of the data it creates problems.
So read it as a text file and split each line and output that directly to your target range - it will therefor stop excel parsing any strings as values - after that you can do whatever you want
option explicit
Sub read_text()
Dim FileToOpen As Variant
FileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")
Dim max_cols As Long
max_cols = 0
Dim r_out As Range
Set r_out = ThisWorkbook.Worksheets("BOM").Range("C1")
Dim row_offset As Long
offset = 0
If FileToOpen <> False Then
Dim fso As Object
Dim file As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.OpenTextFile(FileToOpen, 1)
While Not file.AtEndOfStream
Dim line As String
line = file.ReadLine
Dim line_arr As Variant
line_arr = Split(line, vbTab)
ThisWorkbook.Worksheets("BOM").Range("C1").offset(row_offset, 0) _
.Resize(1, UBound(line_arr) - LBound(line_arr) + 1).Value = line_arr
row_offset = row_offset + 1
Wend
file.Close
End If
End Sub
output