如何在VB6 中加快向表格中充填数据的速度？表头与表格正文的表格格式不一样。

我用VB6编了以下表格打印的程序，表头和表正文不一样，每一页中都带表头，10多页都需要7、8分钟时间，那位专家有好的方法加快数据充填速度？
    Dim WordAppX As New Word.Application
    Dim WordDocX As Word.Document
    Dim WordTableX As Word.Table
        
    '建立Word应用程序
    Set WordAppX = New Word.Application
    '建立Word文档，以当前目录下的cect.doc为模板
    Set WordDocX = WordAppX.Documents.Add(App.Path & "\cect5.dot")
    '向表格中添加数据
    Dim filefreep1 As Integer
    Dim filefreep2 As Integer
    filefreep1 = FreeFile
    filefreep2 = filefreep1 + 1
    '获得表格数
    Dim tablen As Long
    Dim loopi As Long
    Dim tabdoor As Long
    '判断记录是否刚好能充填整个表格
    tabdoor = recnumber Mod 52
    '获取表格数
    If tabdoor = 0 Then
        tablen = Int(recnumber / 52)
    Else
        tablen = Int(recnumber / 52) + 1
    End If
    '充填表头
    
    Dim rec5 As erec5
    
    Open filenamep For Input As filefreep1
    Input #filefreep1, rec5.l1, rec5.l2, rec5.l3, rec5.l5, rec5.s1, rec5.s2, rec5.s3, rec5.s4, rec5.s5, rec5.s6
    Close filefreep1
    rec5.l4 = "清晰"
    For loopi = 1 To 1
        Set WordTableX = WordDocX.Tables(loopi)
        WordTableX.Cell(1, 1).Range.Text = "等外水准测量电子记录手簿"
        WordTableX.Cell(2, 2).Range.Text = rec5.l1
        WordTableX.Cell(2, 4).Range.Text = rec5.l2
        WordTableX.Cell(2, 6).Range.Text = rec5.l3
        WordTableX.Cell(2, 8).Range.Text = rec5.l4
        WordTableX.Cell(2, 10).Range.Text = rec5.l5
    Next    '如果表格大于1，复制表格
    Dim docOld As Document
    Dim rngDoc As Range
    Dim tblDoc As Table
    Dim insb As Range
    Dim li As Integer
    If tablen > 1 Then
        Set docOld = WordDocX
        Set rngDoc = WordDocX.Range(Start:=0, End:=0)
        WordDocX.Tables(1).Range.Copy
        'insb.InsertBreak Type:=wdPageBreak
        For li = 1 To tablen - 1
            Set insb = WordDocX.Content
            With rngDoc
                .Paste
                .Collapse Direction:=wdCollapseEnd
                '.InsertParagraphAfter
                '.Collapse Direction:=wdCollapseEnd
            End With
            'WordDocX.Paragraphs(613 * i).Range.Delete
        Next
    Else
        
    End If
    Open filenamep For Input As filefreep1    pran = WordDocX.Paragraphs.Count
    Dim rec As Long
    Set WordTableX = WordDocX.Tables(1)
    Dim i As Long
    Dim drow As Long
    drow = 4 '表格正文起始行
        '打印整页数据
        For i = 1 To tablen - 1
            For rec = 1 To 52
                Input #filefreep1, rec5.l1, rec5.l2, rec5.l3, rec5.l5, rec5.s1, rec5.s2, rec5.s3, rec5.s4, rec5.s5, rec5.s6
                drow = drow + 1
                WordTableX.Cell(drow, 1).Range.Text = rec5.s1
                WordTableX.Cell(drow, 2).Range.Text = rec5.s3
                WordTableX.Cell(drow, 3).Range.Text = rec5.s2
                WordTableX.Cell(drow, 4).Range.Text = rec5.s4
                WordTableX.Cell(drow, 5).Range.Text = rec5.s5
                WordTableX.Cell(drow, 6).Range.Text = rec5.s6
            Next
            drow = drow + 4
        
        Next
        '打印不够一页的数据
        For i = (tablen - 1) * 52 + 1 To recnumber
            Input #filefreep1, rec5.l1, rec5.l2, rec5.l3, rec5.l5, rec5.s1, rec5.s2, rec5.s3, rec5.s4, rec5.s5, rec5.s6
            drow = drow + 1
            
                WordTableX.Cell(drow, 1).Range.Text = rec5.s1
                WordTableX.Cell(drow, 2).Range.Text = rec5.s3
                WordTableX.Cell(drow, 3).Range.Text = rec5.s2
                WordTableX.Cell(drow, 4).Range.Text = rec5.s4
                WordTableX.Cell(drow, 5).Range.Text = rec5.s5
                WordTableX.Cell(drow, 6).Range.Text = rec5.s6
        Next
    
    'WordAppX.Application.Visible = True
    Dim endp As String
    endp = tablen
    WordDocX.PrintOut Range:=wdPrintFromTo, From:="1", To:=endp