Excel VBA导入TXT文件保留源格式 解决时间戳丢失毫秒日期问题

核心原因 #

直接调用Workbooks.Open打开TXT文件时，Excel会默认自动转换时间字段格式，自动截断毫秒数据，且默认单元格格式不会展示日期部分，最终导致原始数据丢失。

修正后的VBA代码 #

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
Dim i As Integer 

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 <> ""
    ' 替换原Open方法，用OpenText指定列格式避免时间数据丢失
    Workbooks.OpenText Filename:=MyFolder & "\" & MyFile, _
        DataType:=xlDelimited, _
        Tab:=True, ' 若你的TXT为逗号分隔，将此行改为Comma:=True即可
        FieldInfo:=Array(Array(1, 2), 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))
    
    With ActiveSheet
        ' 设置时间列格式，完整展示日期+毫秒
        .Range("A:A").NumberFormat = "yyyy-mm-dd hh:mm:ss.000"
        .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
    ActiveWorkbook.Close SaveChanges:=False
    MyFile = Dir
Loop

ChDir "C:\Users\mjkut\Documents"

End Sub

关键修改说明 #

• 用Workbooks.OpenText替代默认打开方法，通过FieldInfo参数指定第一列（时间列）以文本格式导入，从根源避免Excel自动截断毫秒数据
• 导入后显式设置A列的单元格自定义格式为yyyy-mm-dd hh:mm:ss.000，完整展示日期和3位毫秒信息
• 补充了变量声明和工作簿关闭逻辑，避免运行报错和内存占用过高

内容的提问来源于stack exchange，提问作者mjkutzman