如何把txt数据读写到word表格里？

Question

有个txt文件 c:\a.txt
a.txt数据如下：
小黄@一年级@语文@100
小明@一年级@数学@98
小李@二年级@英语@96
小红@二年级@英语@88
小蓝@一年级@数学@96
小李@二年级@语文@99
有个word文件 c:\b.doc
b.doc 里有一张4列的表（4列分别是姓名、年级、学科、分数）Private Sub Command1_Click()
    Dim TextLine As String '声明一个字符串
    Dim s As String ' 声明一个字符串
    Dim j As Integer '声明一个整数
    Dim XlApp As New Word.Application '声明一个Word应用
    Dim xlBook As New Word.Document '声明一个Word文档
    Set xlBook = XlApp.Documents.Open("c:\b.doc") '打开指定的Word文件
    s = "" '初始化
    j = 0 '初始化
    Open "c:\a.txt" For Input As #1 '打开指定的文本文件
    Do While Not EOF(1)   ' 循环至文件尾。
        j = j + 1 '记数，用来后面指定单元格的行号
        If j >= xlBook.Tables(2).Rows.Count Then '判断行数是不是大于表格行数，如果表格行数不够的话
            xlBook.Tables(2).Cell(j + 1, 1).Select '选中最后一行的第一个格子
            XlApp.Selection.InsertRowsBelow 1 '在该行的后面插入一个空白行
        End If
        Line Input #1, TextLine   ' 读入一行数据并将其赋予某变量。
        For i = 0 To 3 '遍历4列
            x = InStr(1, TextLine, "@") '判断第一个@的位置
            If x <> 0 Then '如果还有@，表示剩下2段以上
                s = Mid(TextLine, 1, x - 1) '截取@前面的部分
            Else
                s = TextLine '没有@就不用截取了，只剩下最后一部分
            End If
            xlBook.Tables(2).Cell(j + 1, i + 1).Range.Text = s 'j行i列单元格赋值
            TextLine = Mid(TextLine, x + 1, Len(TextLine) - x) '剩下的部分取出来
        Next i
    Loop
    Close #1 '关闭Txt文件
    xlBook.Save '保存Word文件
    XlApp.Quit '退出Word文件
End Sub用上面代码可以实现下图：
如果b.doc表格现在变成这样的话如下图：现在如何才能把数据读到象下面图的效果呢？现在有二个问题：
1、如何才能把数据读到象上图的效果？
2、如果b.doc的行不够多的话怎么自动插入？

Answer 1

小case，结贴吧Private Sub Command1_Click()
    Dim TextLine As String '声明一个字符串
    Dim s As String ' 声明一个字符串
    Dim j As Integer '声明一个整数
    Dim XlApp As New Word.Application '声明一个Word应用
    Dim xlBook As New Word.Document '声明一个Word文档
    Set xlBook = XlApp.Documents.Open("c:\b.doc") '打开指定的Word文件
    s = "" '初始化
    j = 0 '初始化
    Open "c:\a.txt" For Input As #1 '打开指定的文本文件
    Do While Not EOF(1)   ' 循环至文件尾。
        j = j + 1 '记数，用来后面指定单元格的行号
        If j >= xlBook.Tables(2).Rows.Count Then '判断行数是不是大于表格行数，如果表格行数不够的话
            xlBook.Tables(2).Cell(j + 1, 1).Select '选中最后一行的第一个格子
            XlApp.Selection.InsertRowsBelow 1 '在该行的后面插入一个空白行
            
        End If
        Line Input #1, TextLine   ' 读入一行数据并将其赋予某变量。
        For i = 0 To 3 '遍历4列
            x = InStr(1, TextLine, "@") '判断第一个@的位置
            If x <> 0 Then '如果还有@，表示剩下2段以上
                s = Mid(TextLine, 1, x - 1) '截取@前面的部分
            Else
                s = TextLine '没有@就不用截取了，只剩下最后一部分
            End If
            xlBook.Tables(2).Cell(j + 1, i + 1).Range.Text = s 'j行i列单元格赋值
            TextLine = Mid(TextLine, x + 1, Len(TextLine) - x) '剩下的部分取出来
        Next i
            xlBook.Tables(2).Cell(j + 1, 5).Range.Text = "家长评价"
    Loop
    Close #1 '关闭Txt文件
    xlBook.Save '保存Word文件
    XlApp.Quit '退出Word文件
End Sub

Answer 2

dbcontrols
 (泰山) 
我怎么在试的时候报错：实时错误‘5941’，集合所要求的成员不存在。按调试后  xlBook.Tables(2).Cell(j + 1, i + 1).Range.Text = s 问题出现在这行。

Answer 3

只给你思路 我替你做了 "成绩表" , 其它的你自己慢慢搞Dim VbWord As Object
Dim VbBook As Object
Dim Table As Object
Dim AppDisk$, Fname$, aa$, i&, j&, Trec&, S, S2
Private Sub Form_Load()
   AppDisk = IIf(Right(App.Path, 1) = "\", App.Path, App.Path & "\")
End SubPrivate Sub Command1_Click()
   '******************* 打开 txt 文件
   Open AppDisk & "a.txt" For Input As #1
   aa = Trim(StrConv(InputB(LOF(1), 1), vbUnicode))
   Close #1
   S = Split(aa, vbNewLine)
   Trec = UBound(S)
   '******************* 创建  Word 文件
   Fname = AppDisk & "b.doc"
   Set VbWord = CreateObject("Word.Application") '创建Word对象
   VbWord.Visible = True
   Set VbBook = VbWord.Documents.Add
   Set Table = VbBook.Tables.Add(VbWord.application.Selection.Range, Trec + 1, 4)
   '******************* 导入标题到 Word
   Table.Cell(1, 1).Range.Text = "姓名"
   Table.Cell(1, 2).Range.Text = "年级"
   Table.Cell(1, 3).Range.Text = "学科"
   Table.Cell(1, 4).Range.Text = "分数"
   '******************* 导入内容到 Word
   For i = 0 To Trec - 1
      If Trim(S(i)) = "" Then Exit For
      S2 = Split(S(i), "@")
      For j = 1 To 4
         Table.Cell(i + 2, j).Range.Text = S2(j - 1)
      Next j
   Next i
   VbWord.ActiveDocument.SaveAs Fname '保存文档 b.doc
   'VbWord.Quit '退出Word文件
   'Set VbWord = Nothing
End Sub

Answer 4

请把你的 a.txt 摆在 app.path 程序同路径b.doc 将在你的 app.path下自动生成

Answer 5

谢谢你的回答，但我要的不是这种效果，我要的是先做好的word模板后把数据导入到d.doc文件里，效果就像下面的截图一样。

Answer 6

我晕.......做好的模版导入数据更为简单 就给你一句 你自己揣摩 太晚了 要睡觉了 上面代码是我替你产生word 你要用现成的模版 那你可以不管我的 "生成"下面代码完全可以导入你 现成 的模版中 思路活些多想想便通了 '******************* 导入内容到 Word
  For i = 0 To Trec - 1
  If Trim(S(i)) = "" Then Exit For
  S2 = Split(S(i), "@")
  For j = 1 To 4
  Table.Cell(i + 2, j).Range.Text = S2(j - 1)
  Next j
  Next i

Answer 7

把第二个表格的所有格子删除，只留下表头，用下列代码
结贴吧
Private Sub Command1_Click()
    Dim TextLine As String '声明一个字符串
    Dim s As String ' 声明一个字符串
    Dim j As Integer '声明一个整数
    Dim XlApp As New Word.Application '声明一个Word应用
    Dim xlBook As New Word.Document '声明一个Word文档
    Set xlBook = XlApp.Documents.Open("c:\b.doc") '打开指定的Word文件
    s = "" '初始化
    j = 0 '初始化
    Open "c:\a.txt" For Input As #1 '打开指定的文本文件
    Do While Not EOF(1)   ' 循环至文件尾。
        j = j + 2 '记数，用来后面指定单元格的行号
        xlBook.Tables(2).Cell(j - 1, 5).Select '选中最后一行的第5个格子
        XlApp.Selection.InsertRowsBelow 1 '在该行的后面插入一个空白行
        XlApp.Selection.InsertRowsBelow 1 '在该行的后面插入一个空白行
        Line Input #1, TextLine   ' 读入一行数据并将其赋予某变量。
        For i = 0 To 3 '遍历4列
            x = InStr(1, TextLine, "@") '判断第一个@的位置
            If x <> 0 Then '如果还有@，表示剩下2段以上
                s = Mid(TextLine, 1, x - 1) '截取@前面的部分
            Else
                s = TextLine '没有@就不用截取了，只剩下最后一部分
            End If
            xlBook.Tables(2).Cell(j, i + 1).Select
            XlApp.Selection.TypeText Text:=s
            TextLine = Mid(TextLine, x + 1, Len(TextLine) - x) '剩下的部分取出来
        Next i
            xlBook.Tables(2).Cell(j, 5).Select
            XlApp.Selection.TypeText Text:="家长评价"
            xlBook.Tables(2).Cell(j + 1, 5).Select
            XlApp.Selection.TypeText Text:="家长评价"
            For x = 0 To 3
                xlBook.Tables(2).Cell(j, x + 1).Select '选择一个格子
                Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend '向下移动选另一个格子
                Selection.Cells.Merge '合并单元格
                Selection.SelectCell
                Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter '居中，下同
                Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
            Next
    Loop
    Close #1 '关闭Txt文件
    xlBook.Save '保存Word文件
    XlApp.Quit '退出Word文件
End Sub