Word VBA导入制表符分隔文本填充Word表格的代码求助

你现有代码存在三个核心问题，导致无法正确填充表格：

• 行数统计逻辑不稳定：通过FSO追加模式读取Line属性计数的方式，会受文件末尾换行、空行影响出现计数偏差，还可能在文件不存在时自动创建空文件
• 表格创建逻辑错误：Selection.InsertRows仅能在已存在的表格结构中插入行，你没有先创建固定3列的基础表格，该行代码本身就会运行报错
• 缺失内容拆分逻辑：读取到的FileContent是整段字符串，没有按换行、制表符拆分成分散的单元格内容，自然无法映射到表格中

• 读取文件全文后，统一换行符格式，按换行拆分为行数组，过滤末尾空行后直接得到准确的有效数据行数，不需要额外调用FSO
• 定位到指定书签位置后，直接用Tables.Add方法一次性创建行列数完全匹配的3列表格
• 遍历每一行数据，按制表符拆分出3个单元格的内容，依次写入对应表格位置，同时兼容某行数据不足3列的异常场景，避免运行报错

Sub ImportTabDelimTxtToWordTable()
    ' 配置项
    Const TextFilePath As String = "C:\Code\Input.txt"
    Const TargetBookmark As String = "ProfilesBegin"
    Const FixedColumnCount As Long = 3
    
    Dim FileContent As String
    Dim lineList As Variant, cellList As Variant
    Dim totalRows As Long, rowIdx As Long, colIdx As Long
    Dim insertRange As Range
    Dim targetTable As Table
    
    ' 读取文本文件全部内容
    Open TextFilePath For Input As #1
    FileContent = Input(LOF(1), #1)
    Close #1
    
    ' 统一换行符格式，拆分所有行
    FileContent = Replace(Replace(FileContent, vbCrLf, vbLf), vbCr, vbLf)
    lineList = Split(FileContent, vbLf)
    
    ' 清除拆分后末尾的空行
    Do While UBound(lineList) >= 0 And lineList(UBound(lineList)) = ""
        ReDim Preserve lineList(UBound(lineList) - 1)
    Loop
    If UBound(lineList) < 0 Then Exit Sub '空文件直接退出
    totalRows = UBound(lineList) + 1
    
    ' 定位到书签后的插入位置
    Selection.GoTo What:=wdGoToBookmark, Name:=TargetBookmark
    Selection.MoveDown Unit:=wdLine, Count:=1
    Set insertRange = Selection.Range
    
    ' 一次性创建对应行列数的表格
    Set targetTable = ActiveDocument.Tables.Add( _
        Range:=insertRange, _
        NumRows:=totalRows, _
        NumColumns:=FixedColumnCount, _
        DefaultTableBehavior:=wdWord9TableBehavior, _
        AutoFitBehavior:=wdAutoFitContent)
    
    ' 逐行逐列填充内容
    For rowIdx = 1 To totalRows
        cellList = Split(lineList(rowIdx - 1), vbTab)
        For colIdx = 1 To FixedColumnCount
            If colIdx - 1 <= UBound(cellList) Then
                targetTable.Cell(rowIdx, colIdx).Range.Text = cellList(colIdx - 1)
            Else
                targetTable.Cell(rowIdx, colIdx).Range.Text = ""
            End If
        Next colIdx
    Next rowIdx
End Sub

• 运行前确认C:\Code\Input.txt路径存在，文件为制表符分隔的3列数据
• 确认当前Word文档中已经存在名为ProfilesBegin的书签，否则定位步骤会报错
• 如果需要调整表格样式，可以在表格创建完成后，通过targetTable对象设置边框、字体等格式

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