Como Importar ficheros texto a Excel mediante una macro.

Tengo que importar varios ficheros texto a Excel y algunos campos tienen ceros a la izquierda y cuando se importan a excel pierdo los ceros. Aqui dejo la macro que uso para cualquier ayuda de que puede estar pasando. Necesito que se importe a excel como un campo text con todos los ceros.

Sub Join_Textfile()
  Dim sh As Worksheet, wb As Workbook, arch As Variant
  Dim lr1 As Long, lr2 As Long, lr3 As Long
  Dim sDatos As Variant, sNombre As String
  '
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  '
  Set sh = Sheets("To_import")
  sh.Rows("2:" & Rows.Count).ClearContents
  With Application.FileDialog(msoFileDialogFilePicker)
      .Title = "Seleccione archivos txt"
      .Filters.Clear
      .Filters.Add "Todos los archivos", "*.txt"
      .AllowMultiSelect = True
      .InitialFileName = "C:\trabajo\folder1"
      If .Show Then
        For Each arch In .SelectedItems
          sDatos = Split(arch, "_")
          sNombre = Split(sDatos(UBound(sDatos)), ".")(0)
          '
          Workbooks.OpenText Filename:=arch, Origin:=xlWindows, _
            StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlNone, _
            ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
            Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
            Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
            Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), _
            Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), _
            Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), Array(23, 1), _
            Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1)), TrailingMinusNumbers:=True
          '
          Set wb = ActiveWorkbook
          lr1 = wb.Sheets(1).Range("A" & Rows.Count).End(3).Row
          lr2 = sh.Range("A" & Rows.Count).End(3).Row + 1
          wb.Sheets(1).Rows("2:" & lr1).Copy sh.Range("A" & lr2)
          lr3 = sh.Range("A" & Rows.Count).End(3).Row
          sh.Range("Y" & lr2 & ":Y" & lr3).Value = sNombre
          wb.Close False
        Next
      End If
  End With

 Un saludo y en espera de alguna recomendacion,

Aleida