VBA/Excel/Access/Word/Access/Access to Excel

Материал из VB Эксперт

Перейти к: навигация, поиск

Copying Records to an Excel Spreadsheet

 
Option Compare Database
Option Explicit
" be sure to select Microsoft Excel Object Library in the References dialog box
Public myExcel As Excel.Application
Sub CopyToExcel()
   Dim conn As ADODB.Connection
   Dim myRecordset As ADODB.Recordset
   Dim wbk As Excel.Workbook
   Dim myWorksheet As Excel.Worksheet
   Dim StartRange As Excel.Range
   Dim strConn As String
   Dim i As Integer
   Dim f As Variant
   On Error GoTo ErrorHandler
   strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & CurrentProject.Path & "\mydb.mdb"
   Set conn = New ADODB.Connection
   Set myRecordset = New ADODB.Recordset
   With myRecordset
      .Open "Employees", strConn, _
          adOpenKeyset, adLockOptimistic
   End With
   Set myExcel = New Excel.Application
   Set wbk = myExcel.Workbooks.Add
   Set myWorksheet = wbk.ActiveSheet
   myExcel.Visible = True
   i = 1
   With myRecordset
      For Each f In .Fields
         With myWorksheet
            .Cells(1, i).Value = f.Name
            i = i + 1
         End With
      Next
   End With
   Set StartRange = myWorksheet.Cells(2, 1)
   StartRange.CopyFromrecordset myRecordset
   myRecordset.Close
   Set myRecordset = Nothing
   myWorksheet.Columns.AutoFit
   wbk.Close SaveChanges:=True, _
       FileName:="C:\ExcelFile.xls"
   myExcel.Quit
   Set conn = Nothing
   Exit Sub
ErrorHandler:
   MsgBox Err.Description, vbCritical, _
      "Automation Error"
   Set myExcel = Nothing
   Exit Sub
End Sub



Exporting to a Spreadsheet

 
Sub transSpread()
     DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
           "tblSales", "C:\Sales.xls"
     MsgBox "Sales spreadsheet created"
End Sub