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

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:

1. Opening a .txt file
2. Ctrl + a
3. Ctrl + c
4. 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