记录集插入文件,例如插入word文件。

Question

'新建流水式报表
Public Sub get_common_rptdata(sql As String, rpt_title As String, _
                                  heder_data As String, foot_data As String, Optional read_reg As Boolean = False)
     Dim i As Integer, j As Integer, k As Integer
     i = 0 And j = 0
     Set Adc_report = MDIForm1.Adc_report
     With Adc_report
       .connectionstring = connectstr()
       .username = "sa"
       .Password = psword
     End With
     If sql = "" Then Exit Sub
     Adc_report.RecordSource = sql
     Adc_report.Refresh
     col_count = Adc_report.Recordset.Fields.Count   '列数：字段数
     row_count = Adc_report.Recordset.RecordCount    '行数：记录数
     If row_count = 0 Then
        MsgBox "记录数为0 ，不能生成报表。", vbOKOnly, "提示"
        Exit Sub
     End If
     msg = MDIForm1.StatusBar1.Panels("prompt").Text
     MDIForm1.StatusBar1.Panels("prompt").Text = "系统正在打开word文档，请稍侯"
         Set appwd = CreateObject("word.application") '创建 word  application 对象
     With appwd
'       .CommandBars("Standard").Enabled = False  '定义标准菜单
'       .CommandBars("Formatting").Enabled = False '定义格式菜单
'       .CommandBars("Menu Bar").Enabled = False
       .Visible = False
       If Not read_reg Then
            Set mydoc = .Documents.Add(, , wdNewBlankDocument, True) '新建word文档
        Else
            Set mydoc = .Documents.Open("c:\temp.doc")  '调用word文档
        End If
        Call mydoc.Activate
        Set aselection = .Selection
        Set arange = .ActiveDocument.Range(0, 1)
        arange.Select
        aselection.Style = "正文"
        aselection.Font.name = "宋体"
        aselection.Font.Size = 14
        aselection.Font.Bold = True
        aselection.InsertAfter ("    " + rpt_title + Chr$(10)) '建立标题
        If heder_data <> "" Then
                Set arange = .ActiveDocument.Range(arange.End - 1, arange.End)
                arange.Select
                aselection.Font.Size = 10
                aselection.Font.Bold = False
                aselection.InsertAfter (heder_data)
        End If
        Set arange = .ActiveDocument.Range(arange.End - 1, arange.End)
        Set mytable = .ActiveDocument.Tables.Add(arange, 1, col_count)
        arange.Select
        aselection.Font.Size = 10
        aselection.Font.Bold = False
        MDIForm1.StatusBar1.Panels("prompt").Text = "word 文档正在获取数据，请稍侯"
        For j = 0 To col_count - 1
                 mytable.Columns(j + 1).Width = 50
                mytable.Cell(1, j + 1).Range.Text = Adc_report.Recordset.Fields(j).name
             If InStr(Adc_report.Recordset.Fields(j).name, "日期") > 0 Then
             End If
                cell_width% = mytable.Cell(1, j + 1).Width
                  field_size% = Adc_report.Recordset.Fields(j).DefinedSize * 2
                If cell_width% < field_size% Then
                   mytable.Cell(1, j + 1).Width = field_size%
                End If
                If InStr(Adc_report.Recordset.Fields(j).name, "日期") > 0 Or InStr(Adc_report.Recordset.Fields(j).name, "时间") > 0 Then
                    mytable.Cell(1, j + 1).Width = 65
                End If
                If InStr(Adc_report.Recordset.Fields(j).name, "单位名称") > 0 Or _
                   InStr(Adc_report.Recordset.Fields(j).name, "承运单位") > 0 Or _
                   InStr(Adc_report.Recordset.Fields(j).name, "付款单位") > 0 Or _
                   InStr(Adc_report.Recordset.Fields(j).name, "提货单位") > 0 Or _
                   InStr(Adc_report.Recordset.Fields(j).name, "地址") > 0 Or _
                   InStr(Adc_report.Recordset.Fields(j).name, "购货单位") > 0 Then
                    mytable.Cell(1, j + 1).Width = 100 ' Adc_report.Recordset.Fields(j).DefinedSize * 7
                End If
                aselection.Font.Size = 10
                aselection.Font.Bold = False
        Next
        arange.End = arange.End + 1
        Set arange = .ActiveDocument.Range(arange.End - 1, arange.End)
        arange.Select
        i = 2
        Set mytable = .ActiveDocument.Tables.Add(arange, row_count, col_count)
        With Adc_report
            .Recordset.movefirst
            While Not .Recordset.EOF
                    For j = 0 To col_count - 1
                          mytable.Cell(i, j + 1).Width = mytable.Cell(1, j + 1).Width
                          aselection.Font.Size = 10
                          aselection.Font.Bold = False
                          If IsNull(.Recordset.Fields(j).value) Then
                             mytable.Cell(i, j + 1).Range.Text = ""
                          Else
                             mytable.Cell(i, j + 1).Range.Text = .Recordset.Fields(j).value
                          End If
                    Next
                    i = i + 1
                    .Recordset.movenext
            Wend
        End With
'        If .CommandBars("Formatting").Controls.Item(12).Caption = "居中(&C)" Then
'             mytable.Select
'            .CommandBars("Formatting").Controls.Item(12).Execute
'        End If
        aselection.MoveEnd
        If foot_data <> "" Then
            aselection.MoveEnd
            Set arange = .ActiveDocument.Range(arange.End - 1, arange.End)
            arange.Select
            aselection.InsertAfter (foot_data)
        End If
        If fpath = "" Then fpath = "c:\temp"
        mydoc.SaveAs Trim(fpath)
        MDIForm1.StatusBar1.Panels("prompt").Text = "数据处理完毕"
        MDIForm1.StatusBar1.Panels("prompt").Text = msg
        On Error GoTo tolable
        Adc_report.Recordset.Close
        Adc_report.RecordSource = ""
        Adc_report.connectionstring = ""
        Adc_report.Refresh
      End With
      Exit Sub
tolable:
      Err.Clear
End Sub

Answer 1

Public numcell, numcol As Integer
 Public col_count, row_count, title_count As Integer
 Public appwd As Word.Application
 Public mydoc As Word.Document
 Public arange As Word.Range
 Public aselection As Word.Selection
 Public mytable As Word.Table
 Dim Adc_report As Adodc

Answer 2

为什么不用microsoft的ado内嵌记录文件格式呢？'存入
……
rst.open
rst.save(文件名)
rst.close
……'打开
……
rst.open 文件名
……