Excel VBA - Preserve source format when importing .txt-CodePudding

Problem:
When importing a .txt, my timestamp column is getting messed up. I'm losing millisecond and date information. I want to import .txt files without losing any information. See below:

Source Format
2021-10-12 10:18:48.258

Excel Format after Import
18:48.3

What I've Tried:
I've played around with Workbooks.OpenText and QueryTables.Add. I have the same problem with Workbooks.OpenText. The macro errors out and won't run when I attempt to use QueryTables.Add.

Context/Code:
VBA macro that opens and edits all .txt files found in a specific folder.

Private Sub CommandButton1_Click()

ChDir "C:\Users\mjkut\Desktop\SmrtSkt\Sensor Data\EXCEL OUTPUT"

Dim MyFolder As String
Dim MyFile As String
Dim Headers() As Variant

MyFolder = "C:\Users\mjkut\Desktop\SmrtSkt\Sensor Data\EXCEL QUEUE"
MyFile = Dir(MyFolder & "\*.txt")
Headers = Array("TIME", "a_X", "a_Y", "a_Z", "w_X", "w_Y", "w_Z", "ang_X", "ang_Y", "ang_Z")

Do While MyFile <> ""
    Workbooks.Open Filename:=MyFolder & "\" & MyFile, Format:=2
    With ActiveSheet
        .Range("B:B,F:F,J:J,N:ZZ").EntireColumn.Delete
        .Range("A1").EntireRow.Insert
            For i = LBound(Headers()) To UBound(Headers())
                .Cells(1, 1   i).Value = Headers(i)
            Next i
        .Rows(1).Font.Bold = True
    End With
    ActiveWorkbook.SaveAs FileFormat:=52
    MyFile = Dir
Loop

ChDir "C:\Users\mjkut\Documents"

End Sub

CodePudding user response：

Please, try the next code. You should use timeColumn to choose the column to be open as text. The code uses 1, just for testing reason. Please set your necessary column number:

Private Sub CommandButton1_Click()
 Dim MyFolder As String, MyFile As String, Headers()
 Dim timeColumn As Long, arrCols(), nrCols As Long, i As Long

 MyFolder = "C:\Users\mjkut\Desktop\SmrtSkt\Sensor Data\EXCEL QUEUE"
 MyFile = dir(MyFolder & "\*.txt")
 Headers = Array("TIME", "a_X", "a_Y", "a_Z", "w_X", "w_Y", "w_Z", "ang_X", "ang_Y", "ang_Z")
 nrCols = UBound(Headers): timeColumn = 1 'the problematic column, to be open as text
 ReDim arrCols(nrCols)

 Do While MyFile <> ""
    For i = 0 To nrCols 'build the array telling to Excel the necessary format for each file column
        If i = timeColumn - 1 Then
            arrCols(i) = Array(1, 2) 'open as text
        Else
            arrCols(i) = Array(1, 1) 'open as General
        End If
    Next
    Workbooks.OpenText fileName:=MyFolder & "\" & MyFile, origin:=932, startRow:=1, DataType:=xlDelimited, _
        Tab:=True, FieldInfo:=arrCols()

    With ActiveSheet
        .Range("B:B,F:F,J:J,N:ZZ").EntireColumn.Delete
        .Range("A1").EntireRow.Insert
            For i = LBound(Headers()) To UBound(Headers())
                .cells(1, 1   i).value = Headers(i)
            Next i
        .rows(1).Font.Bold = True
    End With
    Application.DisplayAlerts = False
      ActiveWorkbook.Close True
    Application.DisplayAlerts = True
    'ActiveWorkbook.saveas FileFormat:=52 'if you prefer this way, you should delete the above way and uncomment this line
                                          'it, probably, must be closed after each iteration, to avoid Excel resources wasting
    MyFile = dir()
 Loop
End Sub

CodePudding user response：

This code using QueryTables works for me. Thank you everyone for acting as a sounding board.

Private Sub CommandButton1_Click()

ChDir "C:\Users\mjkut\Desktop\SmrtSkt\Sensor Data\EXCEL OUTPUT"

Dim MyFolder As String
Dim MyFile As String
Dim ConnStr As String
Dim SaveName As String
Dim Headers() As Variant

MyFolder = "C:\Users\mjkut\Desktop\SmrtSkt\Sensor Data\EXCEL QUEUE"
MyFile = Dir(MyFolder & "\*.txt")
Headers = Array("TIME", "a_X", "a_Y", "a_Z", "w_X", "w_Y", "w_Z", "ang_X", "ang_Y", "ang_Z")

Do While MyFile <> ""
    ConnStr = "TEXT;" & MyFolder & "\" & MyFile
    SaveName = Left(MyFile, Len(MyFile) - 4)
    Workbooks.Add
    Set Sheet = Worksheets(1)
    Set qt = Sheet.QueryTables.Add(Connection:=ConnStr, Destination:=Sheet.Cells(2, 1))
    With qt
        .TextFileCommaDelimiter = True
        .TextFileColumnDataTypes = Array(xlTextFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat, xlGeneralFormat)
        .Refresh
    End With

    With ActiveSheet
        .Range("B:B,F:F,J:J,N:ZZ").EntireColumn.Delete
            For i = LBound(Headers()) To UBound(Headers())
                .Cells(1, 1   i).Value = Headers(i)
            Next i
        .Rows(1).Font.Bold = True
    End With

    ActiveWorkbook.SaveAs Filename:=SaveName, FileFormat:=52
    MyFile = Dir

Loop

ChDir "C:\Users\mjkut\Documents"

End Sub