导入到word或excel文件？

Question

我想把数据库中取出来的一个数据结合显示出来，然后可以按表格的样式导入到一个WORD或EXCEL文件里，可以打印出来，谢谢个位指点！

Answer 1

1，引用Microsoft Excel Object Library
2. Dim xBook As Excel.Workbook
   Set xBook = GetObject("c:\test.xls") 
   xBook.worksheets(1).select
   xBook.Worksheets(1).Range("A1").CopyFromRecordset yourRecordset
   xBook.Save
   XBook.Windows(1).Visible = True
   xBook.Worksheets(1).Visible = true
   set xBook = nothing

Answer 2

access to execel1.增加以下控件    button     4个，名字按代码    texbox  3个  ，  最后一个多行2.增加以下代码 Option ExplicitDim strDBName As StringDim exl As Excel.ApplicationDim eWorkBook As New Excel.WorkbookDim eWorkSheet As New Excel.WorksheetPrivate Sub cmdClose_Click()    Unload MeEnd SubPrivate Sub cmdConvert_Click()    Dim cn As New ADODB.Connection    Dim oSchema As ADODB.Recordset    Dim rs As New ADODB.Recordset    Dim intFldCnt As Integer    Dim i As Integer    Dim j As Integer    Dim sngColWid As Single        On Error GoTo ExcelErr    Screen.MousePointer = vbHourglass        If strDBName = "" Then        MsgBox "Please select a database"        Exit Sub    End If        If txtEXL.Text = "" Then        MsgBox "Please select a name for the new spreadsheet."        Exit Sub    End If    txtResults.Text = ""    txtResults.Text = "Opening Database..." & vbCrLf        cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDBName & ";Persist Security Info=False"    cn.Open (strDBName)    Set oSchema = cn.OpenSchema(adSchemaTables)        Set exl = New Excel.Application    Set eWorkBook = exl.Workbooks.Add    txtResults.Text = txtResults.Text & "Creating Workbook..." & vbCrLf        Do Until oSchema.EOF        If InStr(oSchema!table_name, "MSys") = 0 Then            Set eWorkSheet = eWorkBook.Worksheets.Add            txtResults.Text = txtResults.Text & "Creating Worksheet " & oSchema!table_name & "..." & vbCrLf            If InStr(oSchema!table_name, "/") <> 0 Then                eWorkSheet.Name = Replace(oSchema!table_name, "/", "-")            Else                eWorkSheet.Name = oSchema!table_name            End If                        rs.Open "select * from [" & oSchema!table_name & "]", cn            intFldCnt = rs.Fields.Count - 1            txtResults.Text = txtResults.Text & "Adding Column Headers..." & vbCrLf            For i = 1 To intFldCnt                eWorkSheet.Cells(1, i) = rs.Fields(i).Name                If TextWidth(rs.Fields(i).Name) > sngColWid Then                    sngColWid = TextWidth(rs.Fields(i).Name)                End If            Next i            eWorkSheet.Range("A1", "Z1").Font.Bold = True            eWorkSheet.Range("A1", "Z1").Font.Underline = True                        j = 2            txtResults.Text = txtResults.Text & "Adding Data from Database Table " & oSchema!table_name & "..." & vbCrLf            Do Until rs.EOF                For i = 1 To intFldCnt                    eWorkSheet.Cells(j, i) = rs.Fields(i).Value                Next i                j = j + 1                rs.MoveNext            Loop            rs.Close            Debug.Print oSchema!table_name        End If        oSchema.MoveNext    Loop    txtResults.Text = txtResults.Text & "Done!!!!"    eWorkBook.SaveAs txtEXL.Text    Screen.MousePointer = vbNormal    Exit Sub    ExcelErr:    Screen.MousePointer = vbNormal    Select Case Err.Number        Case 1004            Resume Next        Case Else            MsgBox Err.Number & vbCrLf & Err.Description    End SelectEnd SubPrivate Sub cmdDB_Click()    cdg1.Filter = "MS Access Database (*.mdb)|*.mdb"    cdg1.ShowOpen    strDBName = cdg1.FileName    txtDB.Text = strDBNameEnd SubPrivate Sub cmdEXL_Click()    cdg1.Filter = "MS Excel Spreadsheet (*.xls)|*.xls"    cdg1.ShowOpen    txtEXL.Text = cdg1.FileNameEnd SubPrivate Sub Form_Unload(Cancel As Integer)        On Error Resume Next        exl.Application.Quit    End Sub