将数据从Access表导出到Word表

时间:2018-07-14 18:26:31

标签: ms-access office-interop export-to-word

我有要导出到Word表的Access数据。该表有3列,第一行和第一列都是标题。

我试图遍历记录集并用数据填充第2和第3列。我能够从第2行开始,并填充第2列和第3列,但是我无法弄清楚如何移至下一行。

 iTbl = 1
 irow = 2
 iCol = 1

 Do Until recSet2.EOF
    If irow > wDoc.Tables(iTbl).Rows.Count Then
        wDoc.Tables(iTbl).Rows.Add
    End If

    For Each fld In recSet2.Fields
        On Error Resume Next
        iCol = iCol + 1
        wDoc.Tables(iTbl).Cell(irow, iCol).Range.Text = Nz(fld.Value)
    Next fld
    recSet2.MoveNext
    irow = irow + 1
    iCol = 1
 Loop

2 个答案:

答案 0 :(得分:0)

在Word中创建表(尤其是包含大量数据的表)的最佳方法是首先将数据写入以字符分隔的字符串格式。将字符串分配给Word中的Range,然后使用ConvertToTable方法将其转换为表。这将节省操作对象模型的麻烦,并且是最有效的方法(执行速度最快)。

以下代码演示了此原理。过程Test创建Word的新实例,在Word应用程序中创建新文档,然后将以字符分隔的字符串分配给文档内容。然后将其转换为表格。如果需要格式化该表,请使用tbl对象进行格式化。编写此代码的方式需要对Word对象库的引用(早期绑定)。请注意,也可以使用后期绑定-您会找到大量示例。

第二个过程concatDataTest中被调用以创建字符分隔的字符串。它使用Tab字符作为字段分隔符,并使用回车符作为记录分隔符。 Word将接受几乎所有内容作为字段分隔符;记录分隔符必须是回车符(ANSI 13)。

Sub Test()
    Dim wd As Word.Application
    Dim doc As Word.Document
    Dim rng As Word.Range
    Dim tbl As Word.Table

    Set wd = New Word.Application
    wd.Visible = True
    Set doc = wd.Documents.Add
    Set rng = doc.Content
    rng.Text = concatData()
    Set tbl = rng.ConvertToTable       
End Sub

Public Function concatData() As String
    Dim retVal As String
    Dim rsHeader As Long, rsCounter As Long        
    Dim rs As Recordset

    Set rs = CurrentDb.OpenRecordset("nameOfRecordset", dbOpenDynaset)
    'Get headers
    For rsHeader = 0 To rs.Fields.Count - 1
        retVal = retVal & rs.Fields(rsHeader).Name & vbTab
    Next
    'Replace last TAb with a carriage return
    retVal = Left(retVal, Len(retVal) - 1) & vbCr

    Do While Not rs.EOF
       'Get all records
        For rsCounter = 0 To rs.Fields.Count - 1
            retVal = retVal & rs.Fields(rsCounter).Value & vbTab
        Next
        retVal = Left(retVal, Len(retVal) - 1) & vbCr
        rs.MoveNext
    Loop
    concatData = retVal
End Function

答案 1 :(得分:0)

感谢所有帮助人员。我设法弄清楚了,并且效果很好。它不会向下移动到下一行,并试图将数据写入不存在的column(4),然后引发错误。这是我使用的代码:

iTbl = 1
iRow = 2
iCol = 1

For Each fld In recSet2.Fields
iCol = iCol + 1
    If iCol < 4 Then
        wDoc.Tables(iTbl).Cell(iRow, iCol).Range.Text = Nz(fld.value)
    Else
        If iCol > 3 Then
            iCol = iCol - 2
            iRow = iRow + 1
            wDoc.Tables(iTbl).Cell(iRow, iCol).Range.Text = Nz(fld.value)
        End If
    End If
Next fld