Vba excel select from access

This tutorial will cover the ways to import data from Excel into an Access Table and ways to export Access objects (Queries, Reports, Tables, or Forms) to Excel.

Import Excel File Into Access

To import an Excel file to Access, use the acImport option of DoCmd.TransferSpreadsheet :

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Table1", "C:TempBook1.xlsx", True

Or you can use DoCmd.TransferText to import a CSV file:

DoCmd.TransferText acLinkDelim, , "Table1", "C:TempBook1.xlsx", True

Import Excel to Access Function

This function can be used to import an Excel file or CSV file into an Access Table:

Public Function ImportFile(Filename As String, HasFieldNames As Boolean, TableName As String) As Boolean
' Example usage: call ImportFile ("Select an Excel File",  "Excel Files", "*.xlsx",  "C:" , True,True, "ExcelImportTest", True, True,false,True)

    On Error GoTo err_handler
  
    If (Right(Filename, 3) = "xls") Or ((Right(Filename, 4) = "xlsx")) Then
                DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, TableName, Filename, blnHasFieldNames
            End If
    If (Right(Filename, 3) = "csv") Then
                DoCmd.TransferText acLinkDelim, , TableName, Filename, True
    End If
    
Exit_Thing:

    'Clean up
    'Check if our linked in Excel table already exists... and delete it if so
    If ObjectExists("Table", TableName) = True Then DropTable (TableName)
    Set colWorksheets = Nothing

    Exit Function
    
err_handler:
    If (Err.Number = 3086 Or Err.Number = 3274 Or Err.Number = 3073) And errCount < 3 Then
        errCount = errCount + 1

    ElseIf Err.Number = 3127 Then
        MsgBox "The fields in all the tabs are the same. Please make sure that each sheet has the exact column names if you wish to import mulitple", vbCritical, "MultiSheets not identical"
        ImportFile = False
        GoTo Exit_Thing
    Else
        MsgBox Err.Number & " - " & Err.Description
        ImportFile = False
        GoTo Exit_Thing
        Resume
    End If
End Function

You can call the function like this:

Private Sub ImportFile_Example()
 Call VBA_Access_ImportExport.ImportFile("C:TempBook1.xlsx", True, "Imported_Table_1")
End Sub

Access VBA Export to New Excel File

To export an Access object to a new Excel file, use the DoCmd.OutputTo method or the DoCmd.TransferSpreadsheet method:

Export Query to Excel

This line of VBA code will export a Query to Excel using DoCmd.OutputTo:

DoCmd.OutputTo acOutputQuery, "Query1", acFormatXLSX, "c:tempExportedQuery.xls"

Or you can use the DoCmd.TransferSpreadsheet method instead:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Query1", "c:tempExportedQuery.xls", True

Note: This code exports to XLSX format. Instead you can update the arguments to export to a CSV or XLS file format instead (ex. acFormatXLSX to acFormatXLS).

Export Report to Excel

This line of code will export a Report to Excel using DoCmd.OutputTo:

DoCmd.OutputTo acOutputReport, "Report1", acFormatXLSX, "c:tempExportedReport.xls"

Or you can use the DoCmd.TransferSpreadsheet method instead:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Report1", "c:tempExportedReport.xls", True

Export Table to Excel

This line of code will export a Table to Excel using DoCmd.OutputTo:

DoCmd.OutputTo acOutputTable, "Table1", acFormatXLSX, "c:tempExportedTable.xls"

Or you can use the DoCmd.TransferSpreadsheet method instead:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Table1", "c:tempExportedTable.xls", True

Export Form to Excel

This line of code will export a Form to Excel using DoCmd.OutputTo:

DoCmd.OutputTo acOutputForm, "Form1", acFormatXLSX, "c:tempExportedForm.xls"

Or you can use the DoCmd.TransferSpreadsheet method instead:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "Form1", "c:tempExportedForm.xls", True

Export to Excel Functions

These one line commands work great to export to a new Excel file. However, they will not be able to export into an existing workbook.  In the section below we introduce functions that allow you to append your export to an existing Excel file.

Below that, we’ve included some additional functions to export to new Excel files, including error handling and more.

Export to Existing Excel File

The above code examples work great to export Access objects to a new Excel file.  However, they will not be able to export into an existing workbook.

To export Access objects to an existing Excel workbook we’ve created the following function:

Public Function AppendToExcel(strObjectType As String, strObjectName As String, strSheetName As String, strFileName As String)

    Dim rst As DAO.Recordset
    Dim ApXL As Excel.Application
    Dim xlWBk As Excel.Workbook
    Dim xlWSh As Excel.Worksheet
    Dim intCount As Integer
    Const xlToRight As Long = -4161
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    Const xlContinuous As Long = 1
      
    Select Case strObjectType

    Case "Table", "Query"
        Set rst = CurrentDb.OpenRecordset(strObjectName, dbOpenDynaset, dbSeeChanges)
    Case "Form"
        Set rst = Forms(strObjectName).RecordsetClone
    Case "Report"
        Set rst = CurrentDb.OpenRecordset(Reports(strObjectName).RecordSource, dbOpenDynaset, dbSeeChanges)
    End Select

    If rst.RecordCount = 0 Then
        MsgBox "No records to be exported.", vbInformation, GetDBTitle
    Else
        On Error Resume Next
        Set ApXL = GetObject(, "Excel.Application")
        If Err.Number <> 0 Then
            Set ApXL = CreateObject("Excel.Application")
        End If
        Err.Clear

        ApXL.Visible = False
        
        Set xlWBk = ApXL.Workbooks.Open(strFileName)
        Set xlWSh = xlWBk.Sheets.Add
        xlWSh.Name = Left(strSheetName, 31)

        
        xlWSh.Range("A1").Select
        Do Until intCount = rst.fields.Count
            ApXL.ActiveCell = rst.fields(intCount).Name
            ApXL.ActiveCell.Offset(0, 1).Select
            intCount = intCount + 1
        Loop

        rst.MoveFirst
        
        xlWSh.Range("A2").CopyFromRecordset rst

        With ApXL
            .Range("A1").Select
            .Range(.Selection, .Selection.End(xlToRight)).Select
            .Selection.Interior.Pattern = xlSolid
            .Selection.Interior.PatternColorIndex = xlAutomatic
            .Selection.Interior.TintAndShade = -0.25
            .Selection.Interior.PatternTintAndShade = 0
            .Selection.Borders.LineStyle = xlNone
            .Selection.AutoFilter
            .Cells.EntireColumn.AutoFit
            .Cells.EntireRow.AutoFit
            .Range("B2").Select
            .ActiveWindow.FreezePanes = True
            .ActiveSheet.Cells.Select
            .ActiveSheet.Cells.WrapText = False
            .ActiveSheet.Cells.EntireColumn.AutoFit
            xlWSh.Range("A1").Select
            .Visible = True
        End With

        'xlWB.Close True
        'Set xlWB = Nothing
        'ApXL.Quit
        'Set ApXL = Nothing
    End If
End Function

You can use the function like this:

Private Sub AppendToExcel_Example()
    Call VBA_Access_ImportExport.ExportToExcel("Table", "Table1", "VBASheet", "C:TempTest.xlsx")
End Sub

Notice you are asked to define:

• What to Output? Table, Report, Query, or Form
• Object Name
• Output Sheet Name
• Output File Path and Name.

VBA Programming | Code Generator does work for you!

Export SQL Query to Excel

Instead you can export an SQL query to Excel using a similar function:

Public Function AppendToExcelSQLStatemet(strsql As String, strSheetName As String, strFileName As String)
    Dim strQueryName As String
    Dim ApXL As Excel.Application
    Dim xlWBk As Excel.Workbook
    Dim xlWSh As Excel.Worksheet
    Dim intCount As Integer
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    Const xlVAlignCenter = -4108
    Const xlContinuous As Long = 1
    Dim qdf As DAO.QueryDef
    Dim rst As DAO.Recordset
    
    strQueryName = "tmpQueryToExportToExcel"

    If ObjectExists("Query", strQueryName) Then
        CurrentDb.QueryDefs.Delete strQueryName
    End If
    Set qdf = CurrentDb.CreateQueryDef(strQueryName, strsql)
    Set rst = CurrentDb.OpenRecordset(strQueryName, dbOpenDynaset)

    If rst.RecordCount = 0 Then
        MsgBox "No records to be exported.", vbInformation, GetDBTitle
    Else
        On Error Resume Next
        Set ApXL = GetObject(, "Excel.Application")
        If Err.Number <> 0 Then
            Set ApXL = CreateObject("Excel.Application")
        End If
        Err.Clear

        ApXL.Visible = False
        
        Set xlWBk = ApXL.Workbooks.Open(strFileName)
        Set xlWSh = xlWBk.Sheets.Add
        xlWSh.Name = Left(strSheetName, 31)

        
        xlWSh.Range("A1").Select
        Do Until intCount = rst.fields.Count
            ApXL.ActiveCell = rst.fields(intCount).Name
            ApXL.ActiveCell.Offset(0, 1).Select
            intCount = intCount + 1
        Loop

        rst.MoveFirst
        
        xlWSh.Range("A2").CopyFromRecordset rst

        With ApXL
            .Range("A1").Select
            .Range(.Selection, .Selection.End(xlToRight)).Select
            .Selection.Interior.Pattern = xlSolid
            .Selection.Interior.PatternColorIndex = xlAutomatic
            .Selection.Interior.TintAndShade = -0.25
            .Selection.Interior.PatternTintAndShade = 0
            .Selection.Borders.LineStyle = xlNone
            .Selection.AutoFilter
            .Cells.EntireColumn.AutoFit
            .Cells.EntireRow.AutoFit
            .Range("B2").Select
            .ActiveWindow.FreezePanes = True
            .ActiveSheet.Cells.Select
            .ActiveSheet.Cells.WrapText = False
            .ActiveSheet.Cells.EntireColumn.AutoFit
            xlWSh.Range("A1").Select
            .Visible = True
        End With


        'xlWB.Close True
        'Set xlWB = Nothing
        'ApXL.Quit
        'Set ApXL = Nothing
    End If
End Function

Called like this:

Private Sub AppendToExcelSQLStatemet_Example()
    Call VBA_Access_ImportExport.ExportToExcel("SELECT * FROM Table1", "VBASheet", "C:TempTest.xlsx")
End Sub

Where you are asked to input:

• SQL Query
• Output Sheet Name
• Output File Path and Name.

Function to Export to New Excel File

These functions allow you to export Access objects to a new Excel workbook. You might find them more useful than the simple single lines at the top of the document.

Public Function ExportToExcel(strObjectType As String, strObjectName As String, Optional strSheetName As String, Optional strFileName As String)

    Dim rst As DAO.Recordset
    Dim ApXL As Object
    Dim xlWBk As Object
    Dim xlWSh As Object
    Dim intCount As Integer
    Const xlToRight As Long = -4161
    Const xlCenter As Long = -4108
    Const xlBottom As Long = -4107
    Const xlContinuous As Long = 1

    On Error GoTo ExportToExcel_Err
    DoCmd.Hourglass True

    Select Case strObjectType

    Case "Table", "Query"
        Set rst = CurrentDb.OpenRecordset(strObjectName, dbOpenDynaset, dbSeeChanges)
    Case "Form"
        Set rst = Forms(strObjectName).RecordsetClone
    Case "Report"
        Set rst = CurrentDb.OpenRecordset(Reports(strObjectName).RecordSource, dbOpenDynaset, dbSeeChanges)
    End Select

    If rst.RecordCount = 0 Then
        MsgBox "No records to be exported.", vbInformation, GetDBTitle
        DoCmd.Hourglass False
    Else
        On Error Resume Next
        Set ApXL = GetObject(, "Excel.Application")
        If Err.Number <> 0 Then
            Set ApXL = CreateObject("Excel.Application")
        End If
        Err.Clear
        On Error GoTo ExportToExcel_Err

        Set xlWBk = ApXL.Workbooks.Add
        ApXL.Visible = False

        Set xlWSh = xlWBk.Worksheets("Sheet1")
        If Len(strSheetName) > 0 Then
            xlWSh.Name = Left(strSheetName, 31)
        End If

        xlWSh.Range("A1").Select
        Do Until intCount = rst.fields.Count
            ApXL.ActiveCell = rst.fields(intCount).Name
            ApXL.ActiveCell.Offset(0, 1).Select
            intCount = intCount + 1
        Loop

        rst.MoveFirst
        
        xlWSh.Range("A2").CopyFromRecordset rst

        With ApXL
            .Range("A1").Select
            .Range(.Selection, .Selection.End(xlToRight)).Select
            .Selection.Interior.Pattern = xlSolid
            .Selection.Interior.PatternColorIndex = xlAutomatic
            .Selection.Interior.TintAndShade = -0.25
            .Selection.Interior.PatternTintAndShade = 0
            .Selection.Borders.LineStyle = xlNone
            .Selection.AutoFilter
            .Cells.EntireColumn.AutoFit
            .Cells.EntireRow.AutoFit
            .Range("B2").Select
            .ActiveWindow.FreezePanes = True
            .ActiveSheet.Cells.Select
            .ActiveSheet.Cells.WrapText = False
            .ActiveSheet.Cells.EntireColumn.AutoFit
            xlWSh.Range("A1").Select
            .Visible = True
        End With

retry:
        If FileExists(strFileName) Then
            Kill strFileName
        End If
        If strFileName <> "" Then
            xlWBk.SaveAs strFileName, FileFormat:=56
        End If
        
        rst.Close
        Set rst = Nothing
        DoCmd.Hourglass False
    End If

ExportToExcel_Exit:
    DoCmd.Hourglass False
    Exit Function

ExportToExcel_Err:
    DoCmd.SetWarnings True
    MsgBox Err.Description, vbExclamation, Err.Number
    DoCmd.Hourglass False
    Resume ExportToExcel_Exit

End Function

The function can be called like this:

Private Sub ExportToExcel_Example()
 Call VBA_Access_ImportExport.ExportToExcel("Table", "Table1", "VBASheet")
End Sub

Import or Export Data from Access to Excel using ADO

Microsoft Access: ActiveX Data Objects (ADO), Connect with Access Databases from Excel using VBA.

Part 3 of 4

Microsoft Access: ActiveX Data Objects (ADO), Connect with Access Databases from Excel using VBA:

1. Microsoft Access: ActiveX Data Objects Library (ADO).

2. Microsoft Access: Use ADO to Execute SQL statements.

3. Import or Export Data from Access to Excel using ADO.

4. Microsoft Access: ActiveX Data Objects Extensions (ADOX).

—————

Also Read:

Microsoft Access: Data Access Objects Library (DAO), Connect with Access Databases from Excel using VBA.

———————————————————————————————————

Contents:

Use ADO to Import Data from Microsoft Access Database to Excel

Use ADO to Import data from an Access Database Table to an Excel worksheet (your host application)

Use ADO to Export data from Excel worksheet (your host application) to Access Database Table

———————————————————————————————————

Use ADO to Import Data from Microsoft Access Database to Excel

In this section we show, with the help of practical examples, how to connect to Access Database from Excel (your host application) using ADO to: (i) import or retrieve data from Access database to Excel worksheet; and (ii) Export data from Excel worksheet to Access Database Table.

Range.CopyFromRecordset Method: This method is commonly used to copy records from an Aceess Table to an Excel worksheet. Syntax: Range.CopyFromRecordset(Data, MaxRows, MaxColumns).

Range is the worksheet range to which the records are copied, starting at its upper-left corner. Data is the Recordset (ie. set of records) in the Access database to be copied and the current row in the Recordset is the starting record from where copying begins. MaxRows and MaxColumns refer to the maximum numbers of rows (ie. records) and fields respectively to be copied and omitting these arguments will indicate that all rows and fields are copied. Data is mandatory to specify while other arguments of MaxRows and MaxColumns are optional.

Example 9: Using ADO to Import data from an Access Database Table to an Excel worksheet (your host application).

Refer to Images 9a, 9b, 9c, 9d and 9e as mentioned in the code.

The code is simple to understand, though apparantly long due to multiple options shown (reference to images 9a to 9e) as to how data can be imported into Excel. Each option can be treated as a separate code and run accordingly.

For i = 0 To lFieldCount — 1

‘copy column names in first row of the worksheet:
rng.Offset(0, i).Value = adoRecSet.Fields(i).Name

Next i

For i = 0 To lFieldCount — 1

‘copy column names in first row of the worksheet:

rng.Offset(0, i).Value = adoRecSet.Fields(i).Name

Next i

For i = 0 To lFieldCount — 1

‘copy column names in first row of the worksheet:
rng.Offset(0, i).Value = adoRecSet.Fields(i).Name
adoRecSet.MoveFirst

 ‘copy record values starting from second row of the worksheet:

n = 1

Do While Not adoRecSet.EOF

rng.Offset(n, i).Value = adoRecSet.Fields(i).Value
adoRecSet.MoveNext

n = n + 1

Loop

Next i

For i = 0 To lFieldCount — 1

‘copy column names in first row of the worksheet:
rng.Offset(0, i).Value = adoRecSet.Fields(i).Name
adoRecSet.MoveFirst

‘copy record values starting from second row of the worksheet:

n = 1

Do While Not adoRecSet.EOF

rng.Offset(n, i).Value = adoRecSet.Fields(i).Value
adoRecSet.MoveNext

n = n + 1

Loop

Next i

End Sub

Example 10: Using ADO to Export data from Excel worksheet (your host application) to Access Database Table.

Refer to Images 10a, 10b & 10c, as mentioned in the code.

‘start copying from second row of worksheet, first row contains field names:

For i = 2 To lastRow

adoRecSet.AddNew

For n = 0 To lFieldCount — 1

adoRecSet.Fields(n).Value = ws.Cells(i, n + 1)

Next n

adoRecSet.Update

Next i

End Sub

Add where clause to the select statement

   <source lang="vb">

Sub CreateRst_WithSQL()

  Dim conn As ADODB.Connection
  Dim myRecordset As ADODB.Recordset
  Dim strConn As String
  strConn = "Provider = Microsoft.Jet.OLEDB.4.0;" & _
     "Data Source=" & CurrentProject.Path & _
     "mydb.mdb"
  Set conn = New ADODB.Connection
  conn.Open strConn
  Set myRecordset = conn.Execute("SELECT txtCustFimyRecordsetName, txtCustLastName FROM tblCustomer WHERE txtState = "NJ"")
  Do Until myRecordset.EOF
      For Each fld In myRecordset.Fields
         Debug.Print fld.Name & "=" & fld.Value
      Next fld
      myRecordset.MoveNext
  Loop
  
  myRecordset.Close
  Set myRecordset = Nothing
  conn.Close
  Set conn = Nothing

End Sub

</source>
   
  

Creating a Select Query with ActiveX Data Objects

   <source lang="vb">

Sub Create_SelectQuery()

  Dim cat As ADOX.Catalog
  Dim cmd As ADODB.rumand
  Dim strPath As String
  Dim strSQL As String
  Dim strQryName As String
  On Error GoTo ErrorHandler
  strPath = CurrentProject.Path & "mydb.mdb"
  strSQL = "SELECT Employees.* FROM Employees WHERE Employees.City="London";"
  strQryName = "London Employees"
  Set cat = New ADOX.Catalog
  cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strPath
  Set cmd = New ADODB.rumand
  cmd.rumandText = strSQL
  cat.Views.Append strQryName, cmd

ExitHere:

  Set cmd = Nothing
  Set cat = Nothing
  MsgBox "The procedure completed successfully.", _
      vbInformation, "Create Select Query"
  Exit Sub

ErrorHandler:

  If InStr(Err.Description, "already exists") Then
     cat.Views.Delete strQryName
     Resume
  Else
     MsgBox Err.Number & ": " & Err.Description
     Resume ExitHere
  End If

End Sub

</source>
   
  

Executing a Select Query

   <source lang="vb">

Sub Execute_SelectQuery()

  Dim cmd As ADODB.rumand
  Dim myRecordset As ADODB.Recordset
  Dim strPath As String
  strPath = CurrentProject.Path & "mydb.mdb"
  Set cmd = New ADODB.rumand
  With cmd
     .ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strPath
     .rumandText = "[Products by Category]"
     .rumandType = adCmdTable
  End With
  Set myRecordset = New ADODB.Recordset
  Set myRecordset = cmd.Execute
  Debug.Print myRecordset.GetString
  myRecordset.Close
  Set myRecordset = Nothing
  Set cmd = Nothing

End Sub

</source>
   
  

Get DISTINCT records

   <source lang="vb">

Sub CreateRst_WithSQL()

  Dim conn As ADODB.Connection
  Dim myRecordset As ADODB.Recordset
  Dim strConn As String
  strConn = "Provider = Microsoft.Jet.OLEDB.4.0;" & _
     "Data Source=" & CurrentProject.Path & _
     "mydb.mdb"
  Set conn = New ADODB.Connection
  conn.Open strConn
  Set myRecordset = conn.Execute("SELECT DISTINCT City FROM Employees ")
  Do Until myRecordset.EOF
      For Each fld In myRecordset.Fields
         Debug.Print fld.Name & "=" & fld.Value
      Next fld
      myRecordset.MoveNext
  Loop
  
  myRecordset.Close
  Set myRecordset = Nothing
  conn.Close
  Set conn = Nothing

End Sub

</source>
   
  

Get DISTINCTROW

   <source lang="vb">

Sub CreateRst_WithSQL()

  Dim conn As ADODB.Connection
  Dim myRecordset As ADODB.Recordset
  Dim strConn As String
  strConn = "Provider = Microsoft.Jet.OLEDB.4.0;" & _
     "Data Source=" & CurrentProject.Path & _
     "mydb.mdb"
  Set conn = New ADODB.Connection
  conn.Open strConn
  Set myRecordset = conn.Execute("SELECT DISTINCTROW CompanyName FROM Customers, Orders WHERE Customers.CustomerID = Orders.CustomerID ORDER BY CompanyName; 

«)

  Do Until myRecordset.EOF
      For Each fld In myRecordset.Fields
         Debug.Print fld.Name & "=" & fld.Value
      Next fld
      myRecordset.MoveNext
  Loop
  
  myRecordset.Close
  Set myRecordset = Nothing
  conn.Close
  Set conn = Nothing

End Sub

</source>
   
  

Get more than one column

   <source lang="vb">

Sub CreateRst_WithSQL()

  Dim conn As ADODB.Connection
  Dim myRecordset As ADODB.Recordset
  Dim strConn As String
  strConn = "Provider = Microsoft.Jet.OLEDB.4.0;" & _
     "Data Source=" & CurrentProject.Path & _
     "mydb.mdb"
  Set conn = New ADODB.Connection
  conn.Open strConn
  Set myRecordset = conn.Execute("SELECT FirstName, LastName, PhoneNo FROM Employees")
  Do Until myRecordset.EOF
      For Each fld In myRecordset.Fields
         Debug.Print fld.Name & "=" & fld.Value
      Next fld
      myRecordset.MoveNext
  Loop
  
  myRecordset.Close
  Set myRecordset = Nothing
  conn.Close
  Set conn = Nothing

End Sub

</source>
   
  

Get only one column

   <source lang="vb">

Sub CreateRst_WithSQL()

  Dim conn As ADODB.Connection
  Dim myRecordset As ADODB.Recordset
  Dim strConn As String
  strConn = "Provider = Microsoft.Jet.OLEDB.4.0;" & _
     "Data Source=" & CurrentProject.Path & _
     "mydb.mdb"
  Set conn = New ADODB.Connection
  conn.Open strConn
  Set myRecordset = conn.Execute("SELECT LastName FROM Employees ")
  Do Until myRecordset.EOF
      For Each fld In myRecordset.Fields
         Debug.Print fld.Name & "=" & fld.Value
      Next fld
      myRecordset.MoveNext
  Loop
  
  myRecordset.Close
  Set myRecordset = Nothing
  conn.Close
  Set conn = Nothing

End Sub

</source>
   
  

Get the top 10 percent

   <source lang="vb">

Sub CreateRst_WithSQL()

  Dim conn As ADODB.Connection
  Dim myRecordset As ADODB.Recordset
  Dim strConn As String
  strConn = "Provider = Microsoft.Jet.OLEDB.4.0;" & _
     "Data Source=" & CurrentProject.Path & _
     "mydb.mdb"
  Set conn = New ADODB.Connection
  conn.Open strConn
  Set myRecordset = conn.Execute("SELECT TOP 10 PERCENT * FROM Products ORDER BY UnitPrice ASC; ")
  Do Until myRecordset.EOF
      For Each fld In myRecordset.Fields
         Debug.Print fld.Name & "=" & fld.Value
      Next fld
      myRecordset.MoveNext
  Loop
  
  myRecordset.Close
  Set myRecordset = Nothing
  conn.Close
  Set conn = Nothing

End Sub

</source>
   
  

Get the top 5 percent

   <source lang="vb">

Sub CreateRst_WithSQL()

  Dim conn As ADODB.Connection
  Dim myRecordset As ADODB.Recordset
  Dim strConn As String
  strConn = "Provider = Microsoft.Jet.OLEDB.4.0;" & _
     "Data Source=" & CurrentProject.Path & _
     "mydb.mdb"
  Set conn = New ADODB.Connection
  conn.Open strConn
  Set myRecordset = conn.Execute("SELECT TOP 5 * FROM Products ORDER BY UnitPrice DESC ")
  Do Until myRecordset.EOF
      For Each fld In myRecordset.Fields
         Debug.Print fld.Name & "=" & fld.Value
      Next fld
      myRecordset.MoveNext
  Loop
  
  myRecordset.Close
  Set myRecordset = Nothing
  conn.Close
  Set conn = Nothing

End Sub

</source>
   
  

Loop through the ResultSet after executing select statement

   <source lang="vb">

Sub CreateRst_WithSQL()

  Dim conn As ADODB.Connection
  Dim myRecordset As ADODB.Recordset
  Dim strConn As String
  strConn = "Provider = Microsoft.Jet.OLEDB.4.0;" & _
     "Data Source=" & CurrentProject.Path & _
     "mydb.mdb"
  Set conn = New ADODB.Connection
  conn.Open strConn
  Set myRecordset = conn.Execute("select * from employees")
  Do Until myRecordset.EOF
      For Each fld In myRecordset.Fields
         Debug.Print fld.Name & "=" & fld.Value
      Next fld
      myRecordset.MoveNext
  Loop
  
  myRecordset.Close
  Set myRecordset = Nothing
  conn.Close
  Set conn = Nothing

End Sub

</source>
   
  

Modifying a Select Query

   <source lang="vb">

Sub Modify_Query()

  Dim cat As ADOX.Catalog
  Dim cmd As ADODB.rumand
  Dim strPath As String
  Dim newStrSQL As String
  Dim oldStrSQL As String
  Dim strQryName As String
  strPath = CurrentProject.Path & "mydb.mdb"
  newStrSQL = "SELECT Employees.* FROM Employees" & _
     " WHERE Employees.City="London"" & _
     " ORDER BY BirthDate;"
  strQryName = "London Employees"
  Set cat = New ADOX.Catalog
  cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strPath
  Set cmd = New ADODB.rumand
  Set cmd = cat.Views(strQryName).rumand
  oldStrSQL = cmd.rumandText
  Debug.Print oldStrSQL
  cmd.rumandText = newStrSQL
  Debug.Print newStrSQL
  Set cat.Views(strQryName).rumand = cmd
  Set cmd = Nothing
  Set cat = Nothing

End Sub

</source>
   
  

Order by two fields

   <source lang="vb">

Sub CreateRst_WithSQL()

  Dim conn As ADODB.Connection
  Dim myRecordset As ADODB.Recordset
  Dim strConn As String
  strConn = "Provider = Microsoft.Jet.OLEDB.4.0;" & _
     "Data Source=" & CurrentProject.Path & _
     "mydb.mdb"
  Set conn = New ADODB.Connection
  conn.Open strConn
  Set myRecordset = conn.Execute("SELECT txtCustFirstName, txtCustLastName FROM tblCustomer WHERE txtState = "NJ" ORDER BY txtCustLastName DESC, txtCustFirstName")
  Do Until myRecordset.EOF
      For Each fld In myRecordset.Fields
         Debug.Print fld.Name & "=" & fld.Value
      Next fld
      myRecordset.MoveNext
  Loop
  
  myRecordset.Close
  Set myRecordset = Nothing
  conn.Close
  Set conn = Nothing

End Sub

</source>
   
  

Order record in a decscending order

   <source lang="vb">

Sub CreateRst_WithSQL()

  Dim conn As ADODB.Connection
  Dim myRecordset As ADODB.Recordset
  Dim strConn As String
  strConn = "Provider = Microsoft.Jet.OLEDB.4.0;" & _
     "Data Source=" & CurrentProject.Path & _
     "mydb.mdb"
  Set conn = New ADODB.Connection
  conn.Open strConn
  Set myRecordset = conn.Execute("SELECT * FROM Employees ORDER BY Country DESC")
  Do Until myRecordset.EOF
      For Each fld In myRecordset.Fields
         Debug.Print fld.Name & "=" & fld.Value
      Next fld
      myRecordset.MoveNext
  Loop
  
  myRecordset.Close
  Set myRecordset = Nothing
  conn.Close
  Set conn = Nothing

End Sub

</source>
   
  

Order the resultset with Order by clause

   <source lang="vb">

Sub CreateRst_WithSQL()

  Dim conn As ADODB.Connection
  Dim myRecordset As ADODB.Recordset
  Dim strConn As String
  strConn = "Provider = Microsoft.Jet.OLEDB.4.0;" & _
     "Data Source=" & CurrentProject.Path & _
     "mydb.mdb"
  Set conn = New ADODB.Connection
  conn.Open strConn
  Set myRecordset = conn.Execute("SELECT * FROM Employees ORDER BY EmployeeID ")
  Do Until myRecordset.EOF
      For Each fld In myRecordset.Fields
         Debug.Print fld.Name & "=" & fld.Value
      Next fld
      myRecordset.MoveNext
  Loop
  
  myRecordset.Close
  Set myRecordset = Nothing
  conn.Close
  Set conn = Nothing

End Sub

</source>
   
  

Select all columns

   <source lang="vb">

Sub CreateRst_WithSQL()

  Dim conn As ADODB.Connection
  Dim myRecordset As ADODB.Recordset
  Dim strConn As String
  strConn = "Provider = Microsoft.Jet.OLEDB.4.0;" & _
     "Data Source=" & CurrentProject.Path & _
     "mydb.mdb"
  Set conn = New ADODB.Connection
  conn.Open strConn
  Set myRecordset = conn.Execute("SELECT * FROM Employees")
  Do Until myRecordset.EOF
      For Each fld In myRecordset.Fields
         Debug.Print fld.Name & "=" & fld.Value
      Next fld
      myRecordset.MoveNext
  Loop
  
  myRecordset.Close
  Set myRecordset = Nothing
  conn.Close
  Set conn = Nothing

End Sub

</source>
   
  

Use and to combine conditions

   <source lang="vb">

Sub CreateRst_WithSQL()

  Dim conn As ADODB.Connection
  Dim myRecordset As ADODB.Recordset
  Dim strConn As String
  strConn = "Provider = Microsoft.Jet.OLEDB.4.0;" & _
     "Data Source=" & CurrentProject.Path & _
     "mydb.mdb"
  Set conn = New ADODB.Connection
  conn.Open strConn
  Set myRecordset = conn.Execute("SELECT txtCustFimyRecordsetName, txtCustLastName FROM tblCustomer WHERE txtState = "NJ" AND txtCustLastName = "Miller"")
  Do Until myRecordset.EOF
      For Each fld In myRecordset.Fields
         Debug.Print fld.Name & "=" & fld.Value
      Next fld
      myRecordset.MoveNext
  Loop
  
  myRecordset.Close
  Set myRecordset = Nothing
  conn.Close
  Set conn = Nothing

End Sub

</source>
   
  

Use Between And

   <source lang="vb">

Sub CreateRst_WithSQL()

  Dim conn As ADODB.Connection
  Dim myRecordset As ADODB.Recordset
  Dim strConn As String
  strConn = "Provider = Microsoft.Jet.OLEDB.4.0;" & _
     "Data Source=" & CurrentProject.Path & _
     "mydb.mdb"
  Set conn = New ADODB.Connection
  conn.Open strConn
  Set myRecordset = conn.Execute("Select * FROM Products WHERE UnitPrice NOT BETWEEN 10 and 25 ")
  Do Until myRecordset.EOF
      For Each fld In myRecordset.Fields
         Debug.Print fld.Name & "=" & fld.Value
      Next fld
      myRecordset.MoveNext
  Loop
  
  myRecordset.Close
  Set myRecordset = Nothing
  conn.Close
  Set conn = Nothing

End Sub

</source>
   
  

Use between and with number type column

   <source lang="vb">

Sub CreateRst_WithSQL()

  Dim conn As ADODB.Connection
  Dim myRecordset As ADODB.Recordset
  Dim strConn As String
  strConn = "Provider = Microsoft.Jet.OLEDB.4.0;" & _
     "Data Source=" & CurrentProject.Path & _
     "mydb.mdb"
  Set conn = New ADODB.Connection
  conn.Open strConn
  Set myRecordset = conn.Execute("Select * FROM Products WHERE UnitPrice Between 10 and 25")
  Do Until myRecordset.EOF
      For Each fld In myRecordset.Fields
         Debug.Print fld.Name & "=" & fld.Value
      Next fld
      myRecordset.MoveNext
  Loop
  
  myRecordset.Close
  Set myRecordset = Nothing
  conn.Close
  Set conn = Nothing

End Sub

</source>
   
  

Use Date function in where clause

   <source lang="vb">

Sub CreateRst_WithSQL()

  Dim conn As ADODB.Connection
  Dim myRecordset As ADODB.Recordset
  Dim strConn As String
  strConn = "Provider = Microsoft.Jet.OLEDB.4.0;" & _
     "Data Source=" & CurrentProject.Path & _
     "mydb.mdb"
  Set conn = New ADODB.Connection
  conn.Open strConn
  Set myRecordset = conn.Execute("SELECT * FROM Employees WHERE ((Year([HireDate])<1993) OR (City="Redmond"))      ")
  Do Until myRecordset.EOF
      For Each fld In myRecordset.Fields
         Debug.Print fld.Name & "=" & fld.Value
      Next fld
      myRecordset.MoveNext
  Loop
  
  myRecordset.Close
  Set myRecordset = Nothing
  conn.Close
  Set conn = Nothing

End Sub

</source>
   
  

Use IN and like in where clause

   <source lang="vb">

Sub CreateRst_WithSQL()

  Dim conn As ADODB.Connection
  Dim myRecordset As ADODB.Recordset
  Dim strConn As String
  strConn = "Provider = Microsoft.Jet.OLEDB.4.0;" & _
     "Data Source=" & CurrentProject.Path & _
     "mydb.mdb"
  Set conn = New ADODB.Connection
  conn.Open strConn
  Set myRecordset = conn.Execute("SELECT * FROM Employees WHERE City IN ("Redmond", "London") AND ReportsTo LIKE "Buchanan, Steven" ")
  Do Until myRecordset.EOF
      For Each fld In myRecordset.Fields
         Debug.Print fld.Name & "=" & fld.Value
      Next fld
      myRecordset.MoveNext
  Loop
  
  myRecordset.Close
  Set myRecordset = Nothing
  conn.Close
  Set conn = Nothing

End Sub

</source>
   
  

Use IN in select statement

   <source lang="vb">

Sub CreateRst_WithSQL()

  Dim conn As ADODB.Connection
  Dim myRecordset As ADODB.Recordset
  Dim strConn As String
  strConn = "Provider = Microsoft.Jet.OLEDB.4.0;" & _
     "Data Source=" & CurrentProject.Path & _
     "mydb.mdb"
  Set conn = New ADODB.Connection
  conn.Open strConn
  Set myRecordset = conn.Execute("SELECT * FROM Employees WHERE City IN ("Redmond", "London")")
  Do Until myRecordset.EOF
      For Each fld In myRecordset.Fields
         Debug.Print fld.Name & "=" & fld.Value
      Next fld
      myRecordset.MoveNext
  Loop
  
  myRecordset.Close
  Set myRecordset = Nothing
  conn.Close
  Set conn = Nothing

End Sub

</source>
   
  

Use «Is not null»

   <source lang="vb">

Sub CreateRst_WithSQL()

  Dim conn As ADODB.Connection
  Dim myRecordset As ADODB.Recordset
  Dim strConn As String
  strConn = "Provider = Microsoft.Jet.OLEDB.4.0;" & _
     "Data Source=" & CurrentProject.Path & _
     "mydb.mdb"
  Set conn = New ADODB.Connection
  conn.Open strConn
  Set myRecordset = conn.Execute("Select * from Employees WHERE ReportsTo IS NOT NULL ")
  Do Until myRecordset.EOF
      For Each fld In myRecordset.Fields
         Debug.Print fld.Name & "=" & fld.Value
      Next fld
      myRecordset.MoveNext
  Loop
  
  myRecordset.Close
  Set myRecordset = Nothing
  conn.Close
  Set conn = Nothing

End Sub

</source>
   
  

Use Is NULL to check if a column is null

   <source lang="vb">

Sub CreateRst_WithSQL()

  Dim conn As ADODB.Connection
  Dim myRecordset As ADODB.Recordset
  Dim strConn As String
  strConn = "Provider = Microsoft.Jet.OLEDB.4.0;" & _
     "Data Source=" & CurrentProject.Path & _
     "mydb.mdb"
  Set conn = New ADODB.Connection
  conn.Open strConn
  Set myRecordset = conn.Execute("Select * from Employees WHERE ReportsTo IS NULL")
  Do Until myRecordset.EOF
      For Each fld In myRecordset.Fields
         Debug.Print fld.Name & "=" & fld.Value
      Next fld
      myRecordset.MoveNext
  Loop
  
  myRecordset.Close
  Set myRecordset = Nothing
  conn.Close
  Set conn = Nothing

End Sub

</source>
   
  

Use Not In

   <source lang="vb">

Sub CreateRst_WithSQL()

  Dim conn As ADODB.Connection
  Dim myRecordset As ADODB.Recordset
  Dim strConn As String
  strConn = "Provider = Microsoft.Jet.OLEDB.4.0;" & _
     "Data Source=" & CurrentProject.Path & _
     "mydb.mdb"
  Set conn = New ADODB.Connection
  conn.Open strConn
  Set myRecordset = conn.Execute("SELECT * FROM Employees WHERE City NOT IN ("Redmond", "London") ")
  Do Until myRecordset.EOF
      For Each fld In myRecordset.Fields
         Debug.Print fld.Name & "=" & fld.Value
      Next fld
      myRecordset.MoveNext
  Loop
  
  myRecordset.Close
  Set myRecordset = Nothing
  conn.Close
  Set conn = Nothing

End Sub

</source>
   
  

Use «Select all»

   <source lang="vb">

Sub CreateRst_WithSQL()

  Dim conn As ADODB.Connection
  Dim myRecordset As ADODB.Recordset
  Dim strConn As String
  strConn = "Provider = Microsoft.Jet.OLEDB.4.0;" & _
     "Data Source=" & CurrentProject.Path & _
     "mydb.mdb"
  Set conn = New ADODB.Connection
  conn.Open strConn
  Set myRecordset = conn.Execute("SELECT ALL * FROM Employees ORDER BY EmployeeID; ")
  Do Until myRecordset.EOF
      For Each fld In myRecordset.Fields
         Debug.Print fld.Name & "=" & fld.Value
      Next fld
      myRecordset.MoveNext
  Loop
  
  myRecordset.Close
  Set myRecordset = Nothing
  conn.Close
  Set conn = Nothing

End Sub

</source>
   
  

use SUM in sql statement

   <source lang="vb">

Private Sub RunningSumSQL()

   Dim db As Database
   Set db = CurrentDb
   Dim qry As QueryDef
   Dim sSQL As String
   
   On Error Resume Next
   db.QueryDefs.Delete "temp"
   On Error GoTo 0
   
   sSQL = "SELECT R1.Event,(SELECT SUM(R2.Duration) FROM Running As R2 WHERE R2.Event < R1.Event) AS StartTime FROM Running As R1"
   Set qry = db.CreateQueryDef("temp", sSQL)
   DoCmd.OpenQuery qry.Name

End Sub

</source>
   
  

Use where clause and order by clause together

   <source lang="vb">

Sub CreateRst_WithSQL()

  Dim conn As ADODB.Connection
  Dim myRecordset As ADODB.Recordset
  Dim strConn As String
  strConn = "Provider = Microsoft.Jet.OLEDB.4.0;" & _
     "Data Source=" & CurrentProject.Path & _
     "mydb.mdb"
  Set conn = New ADODB.Connection
  conn.Open strConn
  Set myRecordset = conn.Execute("SELECT txtCustFirstName, txtCustLastName FROM tblCustomer WHERE txtState = "NJ" ORDER BY txtCustLastName, txtCustFirstName

«)

  Do Until myRecordset.EOF
      For Each fld In myRecordset.Fields
         Debug.Print fld.Name & "=" & fld.Value
      Next fld
      myRecordset.MoveNext
  Loop
  
  myRecordset.Close
  Set myRecordset = Nothing
  conn.Close
  Set conn = Nothing

End Sub

</source>
   
  

Use wild card character in link

   <source lang="vb">

Sub CreateRst_WithSQL()

  Dim conn As ADODB.Connection
  Dim myRecordset As ADODB.Recordset
  Dim strConn As String
  strConn = "Provider = Microsoft.Jet.OLEDB.4.0;" & _
     "Data Source=" & CurrentProject.Path & _
     "mydb.mdb"
  Set conn = New ADODB.Connection
  conn.Open strConn
  Set myRecordset = conn.Execute("SELECT txtCustFimyRecordsetName, txtCustLastName FROM tblCustomer WHERE txtCustLastName Like "M*" ")
  Do Until myRecordset.EOF
      For Each fld In myRecordset.Fields
         Debug.Print fld.Name & "=" & fld.Value
      Next fld
      myRecordset.MoveNext
  Loop
  
  myRecordset.Close
  Set myRecordset = Nothing
  conn.Close
  Set conn = Nothing

End Sub

</source>
   
  

Using Date field type in select statement

   <source lang="vb">

Sub FindProject()

   Dim strSQL As String
   Dim rst As ADODB.Recordset
   Set rst = New ADODB.Recordset
   rst.ActiveConnection = CurrentProject.Connection
   rst.CursorType = adOpenStatic
   rst.Open "Select * FROM Employees WHERE BirthDate = #12/31/2007#"
   "Attempt to find a specific project
   strSQL = "[EmployeeID] = " & 1
   rst.Find strSQL
   "Determine if the specified project was found
   If rst.EOF Then
       msgBox lngValue & " Not Found"
   Else
       msgBox lngValue & " Found"
   End If
   rst.Close
   Set rst = Nothing

End Sub

</source>
   
  

You must use a pound symbol (#) when delimiting dates for Microsoft Access, like this:

   <source lang="vb">

Sub FindProject()

   Dim strSQL As String
   Dim rst As ADODB.Recordset
   Set rst = New ADODB.Recordset
   rst.ActiveConnection = CurrentProject.Connection
   rst.CursorType = adOpenStatic
   rst.Open "Select * FROM Employees WHERE BirthDate = #12/31/2007#"
   "Attempt to find a specific project
   strSQL = "[EmployeeID] = " & 1
   rst.Find strSQL
   "Determine if the specified project was found
   If rst.EOF Then
       msgBox lngValue & " Not Found"
   Else
       msgBox lngValue & " Found"
   End If
   rst.Close
   Set rst = Nothing

End Sub

</source>

Option Explicit

Sub CreateAndRunQuery()
    
    '------------------------------------------------------------------------------------------
    'This macro opens the Sample.accdb database, creates and runs a SQL query (filtering
    'all the customers from Canada). Then, it copies selected fields back in the Excel sheet.
    'The code uses late binding, so no reference to an external library is required.
    
    'Written By:    Christos Samaras
    'Date:          05/10/2013
    'Last Updated:  29/11/2014
    'E-mail:        [email protected]
    'Site:          https://www.myengineeringworld.net
    '------------------------------------------------------------------------------------------

    'Declaring the necessary variables.
    Dim con         As Object
    Dim rs          As Object
    Dim AccessFile  As String
    Dim strTable    As String
    Dim SQL         As String
    Dim i           As Integer
            
    'Disable screen flickering.
    Application.ScreenUpdating = False
    
    'Specify the file path of the accdb file. You can also use the full path of the file like:
    'AccessFile = "C:UsersChristosDesktopSample.accdb"
    AccessFile = ThisWorkbook.Path & "" & "Sample.accdb"
    
    'Set the name of the table you want to retrieve the data.
    strTable = "Customers"
    
    On Error Resume Next
    'Create the ADODB connection object.
    Set con = CreateObject("ADODB.connection")
    'Check if the object was created.
    If Err.Number <> 0 Then
        MsgBox "Connection was not created!", vbCritical, "Connection Error"
        Exit Sub
    End If
    On Error GoTo 0
    
    'Open the connection.
    con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & AccessFile
    
    'Create the SQL statement to retrieve the data from the table.
    'Get the necessary information (first name etc.) for all the Canadian customers.
    SQL = "SELECT FirstName, LastName, Address, City, Phone FROM " & strTable & " WHERE COUNTRY='Canada'"
    
    On Error Resume Next
    'Create the ADODB recordset object.
    Set rs = CreateObject("ADODB.Recordset")
    'Check if the object was created.
    If Err.Number <> 0 Then
        'Error! Release the objects and exit.
        Set rs = Nothing
        Set con = Nothing
        'Display an error message to the user.
        MsgBox "Recordset was not created!", vbCritical, "Recordset Error"
        Exit Sub
    End If
    On Error GoTo 0
         
    'Set thee cursor location.
    rs.CursorLocation = 3 'adUseClient on early  binding
    rs.CursorType = 1 'adOpenKeyset on early  binding
    
    'Open the recordset.
    rs.Open SQL, con
    
    'Check if the recordset is empty.
    If rs.EOF And rs.BOF Then
        'Close the recordset and the connection.
        rs.Close
        con.Close
        'Release the objects.
        Set rs = Nothing
        Set con = Nothing
        'Enable the screen.
        Application.ScreenUpdating = True
        'In case of an empty recordset display an error.
        MsgBox "There are no records in the recordset!", vbCritical, "No Records"
        Exit Sub
    End If
    
    'Copy the recordset headers.
    For i = 0 To rs.Fields.Count - 1
        Sheets("New Query").Cells(1, i + 1) = rs.Fields(i).Name
    Next i
    
    'Write the query values in the sheet.
    Sheets("New Query").Range("A2").CopyFromRecordset rs
    
    'Close the recordset and the connection.
    rs.Close
    con.Close
    
    'Release the objects.
    Set rs = Nothing
    Set con = Nothing
    
    'Adjust the columns' width.
    Sheets("New Query").Columns("A:E").AutoFit
    
    'Enable the screen.
    Application.ScreenUpdating = True

    'Inform the user that the macro was executed successfully.
    MsgBox "The Canadian customers were successfully retrieved from the '" & strTable & "' table!", vbInformation, "Done"

End Sub 

Option Explicit

Sub RunExistingQuery()
    
    '------------------------------------------------------------------------------------
    'This macro opens the Sample.accdb database and runs the (existing) qrRegions query
    '(counting the number of customers from each region, based on table Customers).
    'Then, it copies all the query results back in the Excel sheet.
    'The code uses late binding, so no reference to an external library is required.
    
    'Written By:    Christos Samaras
    'Date:          05/10/2013
    'Last Updated:  29/11/2014
    'E-mail:        [email protected]
    'Site:          https://www.myengineeringworld.net
    '------------------------------------------------------------------------------------

    'Declaring the necessary variables.
    Dim con         As Object
    Dim rs          As Object
    Dim AccessFile  As String
    Dim strQuery    As String
    Dim i           As Integer
            
    'Disable screen flickering.
    Application.ScreenUpdating = False
    
    'Specify the file path of the accdb file. You can also use the full path of the file like:
    'AccessFile = "C:UsersChristosDesktopSample.accdb"
    AccessFile = ThisWorkbook.Path & "" & "Sample.accdb"
    
    'Set the name of the query you want to run and retrieve the data.
    strQuery = "qrRegions"
    
    On Error Resume Next
    'Create the ADODB connection object.
    Set con = CreateObject("ADODB.connection")
    'Check if the object was created.
    If Err.Number <> 0 Then
        MsgBox "Connection was not created!", vbCritical, "Connection Error"
        Exit Sub
    End If
    On Error GoTo 0
    
    'Open the connection.
    con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & AccessFile
    
    On Error Resume Next
    'Create the ADODB recordset object.
    Set rs = CreateObject("ADODB.Recordset")
    'Check if the object was created.
    If Err.Number <> 0 Then
        'Error! Release the objects and exit.
        Set rs = Nothing
        Set con = Nothing
        'Display an error message to the user.
        MsgBox "Recordset was not created!", vbCritical, "Recordset Error"
        Exit Sub
    End If
    On Error GoTo 0
         
    'Set thee cursor location.
    rs.CursorLocation = 3 'adUseClient on early  binding
    rs.CursorType = 1 'adOpenKeyset on early  binding
    
    'Open the recordset.
    rs.Open strQuery, con
    
    'Check if the recordset is empty.
    If rs.EOF And rs.BOF Then
        'Close the recordset and the connection.
        rs.Close
        con.Close
        'Release the objects.
        Set rs = Nothing
        Set con = Nothing
        'Enable the screen.
        Application.ScreenUpdating = True
        'In case of an empty recordset display an error.
        MsgBox "There are no records in the recordset!", vbCritical, "No Records"
        Exit Sub
    End If
    
    'Copy the recordset headers.
    For i = 0 To rs.Fields.Count - 1
        Sheets("Existing Access Query").Cells(1, i + 1) = rs.Fields(i).Name
    Next i
    
    'Write the query values in the sheet.
     Sheets("Existing Access Query").Range("A2").CopyFromRecordset rs
    
    'Close the recordset and the connection.
    rs.Close
    con.Close
    
    'Release the objects.
    Set rs = Nothing
    Set con = Nothing
    
    'Adjust the columns' width.
    Columns("A:B").AutoFit
    
    'Enable the screen.
    Application.ScreenUpdating = True

    'Inform the user that the macro was executed successfully.
    MsgBox "All data were  successfully retrieved from the '" & strQuery & "' query!", vbInformation, "Done"

End Sub 

Page last modified: May 16, 2021

Add Content Block

Способы передачи данных из Visual Basic в Excel
Код статьи: 247412 — Список продуктов, к которым относится данная статья.
Развернуть все | Свернуть все
Аннотация
В данной статье рассматриваются способы передачи данных в Microsoft Excel из приложения Microsoft Visual Basic. В статье также представлены преимущества и недостатки каждого из способов, что позволяет пользователю выбрать наиболее подходящий способ для конкретной ситуации.
Перейти к началу страницы | Отправить отзыв
Дополнительная информация
Чаще всего для передачи данных в книгу Excel используется программирование объектов (автоматизация). Этот способ обладает наибольшим спектром возможностей для указания местоположения данных в книге Excel, а также обеспечивает возможность форматирования книги и настройки различных параметров во время выполнения. Программирование объектов позволяет использовать для передачи данных несколько подходов:

Передача данных по одной ячейке
Передача массива данных в диапазон ячеек
Передача набора записей ADO в диапазон ячеек с помощью способа CopyFromRecordset
Создание в листе Excel объекта QueryTable, содержащего результаты запроса по источнику данных ODBC или OLEDB
Передача данных в буфер обмена с последующей вставкой содержимого буфера обмена в лист Excel

Также существуют способы передачи данных в Excel, не требующие программирования объектов. При работе с серверным приложением рекомендуется освободить клиентов от большого объема обрабатываемых данных. Ниже приведены способы передачи данных, не использующие программирование объектов.

Передача данных в текстовый файл, использующий запятые или знаки табуляции в качестве разделителей, который Excel впоследствии может разобрать на ячейки листа
Передача данных на лист Excel с помощью ADO
Передача данных в Excel с помощью динамического обмена данными (DDE)

В следующих разделах приведены дополнительные сведения о каждом решении.

Примечание. При использовании Microsoft Office Excel 2007 для сохранения книги Excel 2007 можно использовать новый формат файла (XSLX). Для этого найдите следующую строку кода в приведенных ниже примерах:

oBook.SaveAs «C:Book1.xls»

Замените этот код следующей строкой кода:

oBook.SaveAs «C:Book1.xlsx»

Кроме того, база данных «Борей» не входит в состав Office 2007 по умолчанию. Тем не менее базу данных «Борей» можно загрузить с веб-узла русской версии Microsoft Office Online.
Перенос данных по одной ячейке с помощью автоматизации
Автоматизация позволяет передавать данные на лист Excel по одной ячейке:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20

   Dim oExcel As Object
   Dim oBook As Object
   Dim oSheet As Object
 
   'Открыть новую книгу Excel
   Set oExcel = CreateObject("Excel.Application")
   Set oBook = oExcel.Workbooks.Add
 
 
   'Добавить данные в ячейки первого листа новой книги
   Set oSheet = oBook.Worksheets(1)
   oSheet.Range("A1").Value = "Last Name"
   oSheet.Range("B1").Value = "First Name"
   oSheet.Range("A1:B1").Font.Bold = True
   oSheet.Range("A2").Value = "Doe"
   oSheet.Range("B2").Value = "John"
 
   'Сохранить книгу и закрыть Excel
   oBook.SaveAs "C:Book1.xls"
   oExcel.Quit

Передача данных по одной ячейке является оптимальным способом передачи небольших объемов данных. Этот способ позволяет помещать данные в любом месте рабочей книги и форматировать ячейки во время выполнения. Однако этот способ не рекомендуется применять при передаче больших объемов данных в книгу Excel. Каждый объект Range, получаемый во время выполнения, вызывает запрос к интерфейсу, поэтому такой способ передачи данных может оказаться очень медленным. Кроме того, в Microsoft Windows 95 и Windows 98 существует ограничение на запросы к интерфейсу, составляющее 64 КБ. При превышении лимита в 64 КБ сервер автоматизации (Excel) может перестать отвечать на запросы или может отображаться сообщение о нехватке памяти. Это ограничение для Windows 95 и Windows 98 рассматривается в следующей статье базы знаний Майкрософт:
216400 Автоматизация COM может привести к зависанию клиентского приложения в Win 95/98 (Эта ссылка может указывать на содержимое полностью или частично на английском языке)
Таким образом, передача данных по одной ячейке допустима только для небольших объемов данных. Для передачи больших объемов данных в Excel следует использовать один из способов, описанных ниже.

Примеры сценариев для автоматизации Excel см. в следующей статье базы знаний Майкрософт:
219151 Использование Visual Basic для автоматизации Microsoft Excel
Передача массива данных в диапазон ячеек листа с помощью программирования объектов
Массив данных можно одновременно передать в диапазон ячеек листа:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27

   Dim oExcel As Object
   Dim oBook As Object
   Dim oSheet As Object
 
   'Открыть новую книгу Excel
   Set oExcel = CreateObject("Excel.Application")
   Set oBook = oExcel.Workbooks.Add
 
   'Создать массив с 3 столбцами и 100 строками
   Dim DataArray(1 To 100, 1 To 3) As Variant
   Dim r As Integer
   For r = 1 To 100
      DataArray(r, 1) = "ORD" & Format(r, "0000")
      DataArray(r, 2) = Rnd() * 1000
      DataArray(r, 3) = DataArray(r, 2) * 0.7
   Next
 
   'Добавить заголовки в строку 1
   Set oSheet = oBook.Worksheets(1)
   oSheet.Range("A1:C1").Value = Array("Order ID", "Amount", "Tax")
 
   'Передать массив на лист, начиная с ячейки A2
   oSheet.Range("A2").Resize(100, 3).Value = DataArray
   
   'Сохранить книгу и закрыть Excel
   oBook.SaveAs "C:Book1.xls"
   oExcel.Quit

Передача большого объема данных с помощью массива происходит значительно быстрее, чем передача данных по одной ячейке. Обратите внимание на строку из приведенного выше сценария, которая одновременно передает данные в 300 ячеек листа:

oSheet.Range(«A2»).Resize(100, 3).Value = DataArray

Эта строка представляет всего два запроса к интерфейсу (один для объекта Range, возвращаемого методом Range, и один для объекта Range, возвращаемого методом Resize). При этом при передаче данных по одной ячейке потребовалось бы 300 запросов к интерфейсу для объектов Range. Поэтому по возможности рекомендуется выполнять массовый перенос данных, чтобы сократить число запросов к интерфейсу.
Перенос набора записей ADO в диапазон листа с помощью автоматизации
В Excel 2000 появился метод CopyFromRecordset, позволяющий переносить наборы данных ADO (или DAO) в диапазон ячеек листа. Приведенный ниже сценарий является примером автоматизации Excel 2000, Excel 2002 или Office Excel 2003 для переноса содержимого таблицы Orders образца базы данных «Борей» с помощью метода CopyFromRecordset.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

   'Создать набор записей из всех записей таблицы Orders
   Dim sNWind As String
   Dim conn As New ADODB.Connection
   Dim rs As ADODB.Recordset
   sNWind = _
      "C:Program FilesMicrosoft OfficeOfficeSamplesNorthwind.mdb"
   conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
      sNWind & ";"
   conn.CursorLocation = adUseClient
   Set rs = conn.Execute("Orders", , adCmdTable)
   
   'Создать новую книгу Excel
   Dim oExcel As Object
   Dim oBook As Object
   Dim oSheet As Object
   Set oExcel = CreateObject("Excel.Application")
   Set oBook = oExcel.Workbooks.Add
   Set oSheet = oBook.Worksheets(1)
   
   'Передать данные в Excel
   oSheet.Range("A1").CopyFromRecordset rs
   
   'Сохранить книгу и закрыть Excel
   oBook.SaveAs "C:Book1.xls"
   oExcel.Quit
   
   'Разорвать соединение
   rs.Close
   conn.Close

Примечание. При использовании версии базы данных «Борей» для Office 2007 необходимо заменить в примере следующую строку кода:

conn.Open «Provider=Microsoft.Jet.OLEDB.4.0ata Source=» & _ sNWind & «;»

Замените эту строку кода следующей строкой:

conn.Open «Provider=Microsoft.ACE.OLEDB.12.0ata Source=» & _ sNWind & «;»

В Excel 97 также имеется метод CopyFromRecordset, однако его можно использовать только для набора записей DAO. CopyFromRecordset в Excel 97 не поддерживает ADO.

Дополнительные сведения об использовании ADO и метода CopyFromRecordset см. в следующей статье базы знаний Майкрософт:
246335 Использование программирования объектов для передачи данных из набора записей в Excel (Эта ссылка может указывать на содержимое полностью или частично на английском языке)
Создание объекта QueryTable с помощью программирования объектов
Объект QueryTable представляет собой таблицу, содержащую данные, возвращенные из внешнего источника. При автоматизации Microsoft Excel для создания объекта QueryTable следует просто указать строку подключения к источнику данных OLEDB или ODBC в строке SQL. Далее Excel генерирует набор записей и вставляет его в указанное местоположение на листе. Использование объекта QueryTables обладает несколькими преимуществами по сравнению с использованием метода CopyFromRecordset:

Созданием набора записей и его размещением на листе управляет Excel.
Запрос можно сохранить в объекте QueryTable таким образом, чтобы в дальнейшем его можно было обновить и получить обновленный набор записей.
При добавлении нового объекта QueryTable к листу можно переместить данные, уже находящиеся в ячейках листа, чтобы свободно разместить новые данные (см. свойство RefreshStyle).

Ниже приводится пример сценария, позволяющего автоматизировать Excel 2000, Excel 2002 или Office Excel 2003 для создания нового объекта QueryTable на листе Excel с данными из базы Northwind:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

   'Создать новую книгу Excel
   Dim oExcel As Object
   Dim oBook As Object
   Dim oSheet As Object
   Set oExcel = CreateObject("Excel.Application")
   Set oBook = oExcel.Workbooks.Add
   Set oSheet = oBook.Worksheets(1)
   
   'Создать объект QueryTable
   Dim sNWind As String
   sNWind = _
      "C:Program FilesMicrosoft OfficeOfficeSamplesNorthwind.mdb"
   Dim oQryTable As Object
   Set oQryTable = oSheet.QueryTables.Add( _
   "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
      sNWind & ";", oSheet.Range("A1"), "Select * from Orders")
   oQryTable.RefreshStyle = xlInsertEntireRows
   oQryTable.Refresh False
   
   'Сохранить книгу и закрыть Excel
   oBook.SaveAs "C:Book1.xls"
   oExcel.Quit

Использование буфера обмена
Буфер обмена Windows также может использоваться как механизм передачи данных на лист Excel. Чтобы вставить данные в несколько ячеек листа, можно скопировать строку, в которой столбцы разделены знаками табуляции, а строки – символами возврата каретки. В приведенном ниже сценарии показано, как Visual Basic может использовать буфер обмена для передачи данных в Excel:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

   'Скопировать строку в буфер обмена
   Dim sData As String
   sData = "FirstName" & vbTab & "LastName" & vbTab & "Birthdate" & vbCr _
           & "Bill" & vbTab & "Brown" & vbTab & "2/5/85" & vbCr _
           & "Joe" & vbTab & "Thomas" & vbTab & "1/1/91"
   Clipboard.Clear
 
   Clipboard.SetText sData
   
   'Создать новую книгу Excel
   Dim oExcel As Object
   Dim oBook As Object
   Set oExcel = CreateObject("Excel.Application")
   Set oBook = oExcel.Workbooks.Add
   
 
   'Вставить данные
   oBook.Worksheets(1).Range("A1").Select
   oBook.Worksheets(1).Paste
   
   'Сохранить книгу и закрыть Excel
   oBook.SaveAs "C:Book1.xls"
   oExcel.Quit

Создание текстового файла с разделителями, который Excel может разобрать на строки и столбцы
Excel может открывать файлы с разделителями-запятыми и знаками табуляции и разбирать данные по ячейкам. Этим можно воспользоваться при необходимости передачи большого объема данных в лист Excel с минимальным использованием автоматизации. Этот подход рекомендуется для приложений типа клиент-сервер, поскольку текстовый файл может генерироваться серверным приложением. Затем текстовый файл можно открыть с помощью клиентского приложения, при необходимости используя автоматизацию.

Ниже приведен сценарий, иллюстрирующий создание текстового файла с разделителями-запятыми из набора записей ADO:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

   'Создать набор записей из всех записей таблицы Orders
   Dim sNWind As String
   Dim conn As New ADODB.Connection
   Dim rs As ADODB.Recordset
   Dim sData As String
   sNWind = _
      "C:Program FilesMicrosoft OfficeOfficeSamplesNorthwind.mdb"
   conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
      sNWind & ";"
   conn.CursorLocation = adUseClient
   Set rs = conn.Execute("Orders", , adCmdTable)
   
   'Сохранить набор записей как файл с символами табуляции в качестве разделителей
   sData = rs.GetString(adClipString, , vbTab, vbCr, vbNullString)
   Open "C:Test.txt" For Output As #1
   Print #1, sData
   Close #1
    
   'Разорвать соединение
   rs.Close
   conn.Close
   
   'Открыть новый текстовый файл в Excel
   Shell "C:Program FilesMicrosoft OfficeOfficeExcel.exe " & _
      Chr(34) & "C:Test.txt" & Chr(34), vbMaximizedFocus

Примечание. При использовании версии базы данных «Борей» для Office 2007 необходимо заменить в примере следующую строку кода:

conn.Open «Provider=Microsoft.Jet.OLEDB.4.0ata Source=» & _
sNWind & «;»

Замените эту строку кода следующей строкой:

conn.Open «Provider=Microsoft.ACE.OLEDB.12.0ata Source=» & _
sNWind & «;»

Если файл имеет расширение CSV, Excel открывает его без отображения мастера импорта текста и по умолчанию принимает, что в файле используются разделители-запятые. Если же файл имеет расширение TXT, Excel автоматически разбирает его, используя в качестве разделителей знаки табуляции.

В приведенном выше примере запуск Excel осуществлялся с помощью оператора Shell, а имя файла использовалось как аргумент командной строки. А в этом примере автоматизация не использовалась. Однако при желании можно применить минимум автоматизации, чтобы открыть текстовый файл и сохранить его в формате книги Excel:

1
2
3
4
5
6
7
8
9
10
11
12

   'Создать новый экземпляр Excel
   Dim oExcel As Object
   Dim oBook As Object
   Dim oSheet As Object
   Set oExcel = CreateObject("Excel.Application")
       
   'Открыть текстовый файл
   Set oBook = oExcel.Workbooks.Open("C:Test.txt")
   
   'Сохранить книгу Excel и закрыть Excel
   oBook.SaveAs "C:Book1.xls", xlWorkbookNormal
   oExcel.Quit

Дополнительные сведения об операциях ввода-вывода файлов из приложения Visual Basic см. в следующей статье базы знаний Майкрософт:
172267 RECEDIT.VBP демонстрирует ввод-вывод файлов в Visual Basic (Эта ссылка может указывать на содержимое полностью или частично на английском языке)
Передача данных на лист Excel с помощью ADO
С помощью Microsoft Jet OLE DB Provider можно добавлять записи в таблицу существующей книги Excel. «Таблицей» в Excel считается диапазон с заданным именем. Первая строка диапазона содержит заголовки (или имена полей), а все последующие строки – записи. Ниже приведен пример создания книги с пустой таблицей MyTable.
Excel 97, Excel 2000 и Excel 2003

Откройте новую книгу Excel.
Добавьте следующие заголовки в ячейки A1:B1 листа Sheet1:

A1: FirstName B1: LastName
Выровняйте ячейку B1 по правому краю.
Выделите A1:B1.
В меню Вставка выберите Имя, а затем Присвоить. Введите имя MyTable и нажмите кнопку OK.
Сохраните новую книгу как C:Book1.xls и закройте Excel.

Чтобы добавить записи в таблицу MyTable с помощью ADO, понадобится сценарий приблизительно следующего вида:

‘Создать новый объект подключения для Book1.xls
Dim conn As New ADODB.Connection
conn.Open «Provider=Microsoft.Jet.OLEDB.4.0;» & _
«Data Source=C:Book1.xls;Extended Properties=Excel 8.0;»
conn.Execute «Insert into MyTable (FirstName, LastName)» & _
» values (‘Bill’, ‘Brown’)»
conn.Execute «Insert into MyTable (FirstName, LastName)» & _
» values (‘Joe’, ‘Thomas’)»
conn.Close

Excel 2007

В Excel 2007 создайте книгу.
Добавьте следующие заголовки в ячейки A1:B1 листа «Лист1»:

A1: FirstName B1: LastName
Выровняйте ячейку B1 по правому краю.
Выделите диапазон A1:B1.
На ленте откройте вкладку Формулы и выберите пункт Определить имя. Введите имя MyTable и нажмите кнопку ОК.
Сохраните новую книгу как C:Book1.xlsx и закройте Excel.

Чтобы добавить записи в таблицу MyTable с помощью ADO, используйте код, подобный приведенному ниже.

‘Создание объекта соединения для Book1.xls
Dim conn As New ADODB.Connection
conn.Open «Provider=Microsoft.ACE.OLEDB.12.0;» & _
«Data Source=C:Book1.xlsx;Extended Properties=Excel 12.0;»
conn.Execute «Insert into MyTable (FirstName, LastName)» & _
» values (‘Scott’, ‘Brown’)»
conn.Execute «Insert into MyTable (FirstName, LastName)» & _
» values (‘Jane’, ‘Dow’)»
conn.Close

При подобном добавлении записей в таблицу производится форматирование книги. В приведенном выше примере новые поля, добавляемые в столбец B, выравниваются по правому краю. Каждая запись, добавляемая в строку, форматируется так же, как предыдущая.

Обратите внимание на то, что при добавлении в ячейку или ячейки листа запись заменяет любые данные, находившиеся в этих ячейках ранее; другими словами, строки листа не сдвигаются вниз при добавлении новых записей. Это следует иметь в виду при планировании размещения данных на листе.

Примечание. Обновление данных на листе Excel с помощью ADO или DAO невозможно в среде Visual Basic для приложений в Access после установки пакета обновления 2 (SP2) для Office 2003 или обновления для Access 2002, описанного в статье 904018 базы знаний Майкрософт. Однако этот способ можно использовать в среде Visual Basic для приложений в других приложениях Office, например в Word, Excel и Outlook. Дополнительные сведения см. в следующих статьях базы знаний Майкрософт:
904953 Запрещается вносить изменения, добавлять или удалять данные, источником которых являются книги Excel в Office Access 2003 или в Access 2002
904018 Описание обновления для Access 2002: от 18 октября 2005 г.

Дополнительные сведения об использовании ADO для доступа к книгам Excel см. в следующих статьях базы знаний Майкрософт:
195951 Создание запросов и обновление данных Excel с помощью ADO со страниц ASP (Эта ссылка может указывать на содержимое полностью или частично на английском языке)
Передача данных в Excel с помощью DDE
Наряду с программированием объектов DDE является способом связи с Excel и передачи данных; однако, в противоположность автоматизации и COM, DDE больше не является часто используемым способом связи с другими приложениями и должен использоваться только при отсутствии других решений.

Для передачи данных в Excel с помощью DDE можно воспользоваться одним из следующих способов:

LinkPoke для вставки данных в указанный диапазон ячеек

-или-
LinkExecute для отправки команд, которые будет выполнять Excel.

В приведенном ниже примере показано, как установить связь DDE с Excel таким образом, чтобы модно было поместить данные в ячейки листа и выполнить команды. В этом примере для успешного установления связи DDE с файлом LinkTopic Excel|MyBook.xls книга с именем MyBook.xls уже должна быть открыта в запущенном экземпляре Excel.

Примечание. При использовании Excel 2007 для сохранения книг можно использовать новый формат файла (XLSX). Обязательно обновите имя файла в приведенном ниже примере кода.

Примечание. В данном примере Text1 представляет элемент управления Text Box формы Visual Basic:

‘Установить связь DDE с Excel
Text1.LinkMode = 0
Text1.LinkTopic = «Excel|MyBook.xls»
Text1.LinkItem = «R1C1:R2C3»
Text1.LinkMode = 1

‘Вставить текст из Text1 в ячейки R1C1:R2C3 файла MyBook.xls
Text1.Text = «one» & vbTab & «two» & vbTab & «three» & vbCr & _
«four» & vbTab & «five» & vbTab & «six»
Text1.LinkPoke

‘Выполнить следующие команды – выбрать ячейку A1 (R1C1) и изменить шрифт
‘format
Text1.LinkExecute «[SELECT(«»R1C1″»)]»
Text1.LinkExecute «[FONT.PROPERTIES(«»Times New Roman»»,»»Bold»»,10)]»

‘Разорвать связь DDE
Text1.LinkMode = 0

При использовании метода LinkPoke с Excel необходимо указать диапазон в формате строка-столбец (R1C1) для LinkItem. Если данные вставляются в несколько ячеек, можно использовать строку, в которой столбцы разделены символами табуляции, а строки – символами возврата каретки.

Если метод LinkExecute используется для выполнения команды в Excel, синтаксис команды должен соответствовать языку Excel Macro Language (XLM). Документация по XLM не входит в состав Excel 97 и более поздних версий. Дополнительные сведения о получении документации по XLM см. в следующей статье базы знаний Майкрософт:
143466 Файл Macro97.exe доступен для загрузки (Эта ссылка может указывать на содержимое полностью или частично на английском языке)
DDE не является рекомендуемым способом связи с Excel. Программирование объектов предоставляет больше возможностей и обеспечивает лучший доступ к новым функциям Excel.
Перейти к началу страницы | Отправить отзыв
Ссылки
Дополнительные сведения см. в следующей статье базы знаний Майкрософт:
306022 Передача данных в книгу Excel с помощью Visual Basic .NET (Эта ссылка может указывать на содержимое полностью или частично на английском языке)
Перейти к началу страницы | Отправить отзыв
Свойства
Код статьи: 247412 — Последнее изменение :: 20 марта 2007 г. — Редакция: 8.0
Информация в данной статье относится к следующим продуктам.

Microsoft Office Excel 2007
Microsoft Office Excel 2003
Microsoft Excel 2002 Standard Edition
Microsoft Excel 2000 Standard Edition
Microsoft Excel 97 Standard Edition
Microsoft Visual Basic for Applications 5.0
Microsoft Visual Basic for Applications 6.0
Microsoft Visual Basic 6.0 Enterprise Edition
Microsoft Visual Basic 6.0 Professional Edition

Ключевые слова:
kbautomation kbdde kbinfo KB247412
Перейти к началу страницы | Отправить отзыв

Импорт и Экспорт данных из mdb (Access) в Excel на VBA

Опубликовал Deys в ср, 16/10/2013 — 22:23

Версия для печати

Программные продукты MS Access и MS Excel относятся к одному пакету MS Office, но из-за лицензионных ограничений, не на все рабочие станции может быть установлен Access. Может возникнуть такая ситуация, что сотруднику, который работает только с Excel, потребуются некоторые данные, которые содержатся в базе Access. Как быть? Можно установить копию Access, но т.к. эта надобность может быть разовой или очень редкой, то приобретение лицензии экономически невыгодно. Можно попросить разработчика mdb создать отчет, который бы экспортировался в Excel. А можно, зная структуру таблиц БД Access, написать небольшой макрос (а можно и большой) который бы импортировал данные в книгу Excel и обрабатывал их особым образом. Есть еще один способ, это использовать инструменты Excel — «Импорт внешних данных», но о нем в других статьях. А пока рассмотрим пример на VBA.

Для импорта/экспорта будем использовать библиотеку MS DAO 3.6 Object Library, которая поставляется вместе с VBA. Включите ее в новом проекте. Для этого в редакторе VBA (Alt+F11) откройте Tools — References, найдите в списке «Microsoft DAO 3.6 Object Library» и поставьте галочку.

библиотека MS DAO 3.6 VBA

Например, у нас есть некая база данных комплектующих к ПК, прайс лист проще говоря. Таблица называется «tbl_прайс» и имеет следующую структуру:

ID — поле типа счетчик;

Вид — поле типа «Текст (String)» с длинной 50 символов. Содержит принадлежность к виду комплектующих (Процессор, Материнка, ОЗУ и т.д.);

Производитель — тип текст, длина 50;

Модель — содержит номер и краткие характеристики модели. Поле так же, текст, длина 255;

Количество — поле типа «Числовой», Размер — «Длинное целое». Содержит кол-во комплектующих на складе;

Цена — поле типа «Числовой», Размер — «Действительное». Указывает цену за единицу товара.

Можете создать и наполнить данными базу mdb, а можете взять используемую базу в примерах ниже здесь.

Итак, база есть, например, нам необходимо полностью прочитать таблицу БД («tbl_прайс») и вывести результат на лист Excel. Cоздаем новый модуль и добавляем в него процедуру следующего содержания:

Sub ReadMDB()

‘переменная хранящая результат запроса

Dim tbl As Recordset

‘строка запроса SQL

Dim SQLr As String

‘переменная хранящая ссылку на подключенную БД

Dim dbs As Database

‘подключаемся к mdb

Set dbs = DAO.OpenDatabase(«E:price.mdb»)

‘составляем строку SQL запроса

SQLr = «SELECT * FROM tbl_прайс»

‘отправляем запрос открытой БД

‘результат в виде таблицы сохранен в tbl

Set tbl = dbs.OpenRecordset(SQLr)

‘вставляем результат в лист начиная с ячейки A1

Cells(1, 1).CopyFromRecordset tbl

‘Закрываем временную таблицу

tbl.Close

‘Очищаем память. Если этого не сделать, то таблица

‘так и останется висеть в оперативке.

Set tbl = Nothing

‘Закрываем базу

dbs.Close

Set dbs = Nothing

End Sub

Логика работы этой и всех последующих процедур чтения(записи) данных в БД проста. Сначала мы открываем БД, затем отправляем SQL запрос, получаем результат запроса в виде таблицы, закрываем БД, освобождаем память.

В данном варианте мы использовали метод CopyFromRecordset ячейки листа т.е. вставили результат запроса в лист так как есть, но что делать если результат нужно еще обработать некоторым образом который невозможно описать в запросе!? Ниже код демонстрирует построчное чтение результата запроса в цикле Do While (как работает цикл Do While описано в этой статье):

Sub ReadMDB_построчно()

Dim tbl As Recordset

Dim SQLr As String

Dim dbs As Database

Dim i As Integer

Set dbs = DAO.OpenDatabase(«E:price.mdb»)

SQLr = «SELECT * FROM tbl_прайс»

Set tbl = dbs.OpenRecordset(SQLr)

i = 1

‘выполняем цикл пока не конец tbl

Do While Not tbl.EOF

‘присваиваем каждой ячейке значение из полей таблицы

Cells(i, 1) = tbl.Fields(«ID»)

Cells(i, 2) = tbl.Fields(«Вид»)

Cells(i, 3) = tbl.Fields(«Производитель»)

Cells(i, 4) = tbl.Fields(«Модель»)

Cells(i, 5) = tbl.Fields(«Количество»)

Cells(i, 6) = tbl.Fields(«Цена»)

‘и для примера получим сумму (цена*кол-во)

Cells(i, 7) = tbl.Fields(«Количество») * tbl.Fields(«Цена»)

i = i + 1

tbl.MoveNext ‘переход к следующей записи

Loop

tbl.Close

Set tbl = Nothing

dbs.Close

Set dbs = Nothing

End Sub

Обратите внимание, второй вариант выводит результат на лист заметно медленнее, чем первый! Поэтому рекомендую по возможности использовать первый вариант.

Метод OpenRecordset позволяет только считывать данные из таблиц БД с помощью запросов. Для того чтобы выполнить запросы на изменение, добавление или удаление записей в таблицах используется метод Execute. Смотрим пример, который позволяет добавить запись в таблицу (при соответствующем SQL запросе можно изменить, удалить записи):

Sub ReadMDB_добавить_запись()

Dim tbl As Recordset

Dim SQLr As String

Dim dbs As Database

Dim kol As Long

Set dbs = DAO.OpenDatabase(«E:price.mdb»)

Set tbl = dbs.OpenRecordset(«tbl_прайс»)

‘метод RecordCount позволяет получить кол-во записей

‘Kol хранит ID для новой записи

kol = tbl.RecordCount + 1

SQLr = «INSERT INTO tbl_прайс (ID,Вид,Производитель, Модель,Количество, Цена)» _

& «Values (» & kol & «,’ОЗУ’,’Hyndai’, ‘DDR3’, 123, 600)»

dbs.Execute SQLr

tbl.Close

Set tbl = Nothing

dbs.Close

Set dbs = Nothing

End Sub

В этих примерах показаны основные моменты работы с БД mdb, которые помогут организовать обмен данными между Excel и Access, но эти способы не являются единственно верными и правильными. На этом все. До встреч!

Прикрепленный файл: Чтение mdb на VBA.zip

How to Connect Access Database in Excel Macros?

Updating Excel Spreadsheet from Access Database using this step by step Excel VBA Access Macro code is just that simple. We are going to use a ADODB connection in this sample code.

Just copy paste this Excel VBA Access MDB conenction code to your VBA Project.

Excel To Access Connection – Simplest Code

Just change these two things in the code. It is enough for this to work better.

1. Database path – sDBPath : This should have the exact folder path & MDB Access file name that is being accessed with this code.
2. Query String – sQuery : The SQL query in this variable should match the Database Table & the fields exactly as how it is defined in the MDB database.

Once these two fields are edited, then this code will perfectly fine in a Excel VB Editor.

'--------------------------------------------------------------------------------
'Code by author@officetricks.com (or) kumarapush777 (Fiverr)
'Visit https://officetricks.com to get more Free & Fully Functional VBA Codes
'--------------------------------------------------------------------------------
Sub VBA_Connect_To_MDB_ACCESS()

    'Make Reference to Microsoft AxticX Data Objects Library
    Dim dbConn As ADODB.Connection, dbRecSet As ADODB.Recordset
    Dim sConnString As String, sQuery As String
    Dim sDBPath As String
    
    'Define MDB ACCESS file path
    sDBPath = "D:OfficeTricksSalesOrders.accdb"
    
    'SQL Query String
    sQuery = "SELECT CustomerID, CustFirstName , CustLastName from Customers;"
    
    'ADODB Conenction String to initiate connection with MDB ACCESS
    sConnString = "Provider=Microsoft.ace.OLEDB.12.0; Data Source=" & sDBPath & ";"
    
    'Open Connection
    Set dbConn = New ADODB.Connection
    dbConn.Open ConnectionString:=sConnString
    
    'Execute SQL Query & Get Records matching the query to recordset
    Set dbRecSet = New ADODB.Recordset
    dbRecSet.Open Source:=sQuery, ActiveConnection:=dbConn
    
    'If Query Returned Values, Read them one by one
    If (dbRecSet.RecordCount <> 0) Then
        Do While Not dbRecSet.EOF
            MsgBox dbRecSet.Fields(1).Value
            dbRecSet.MoveNext
        Loop
    End If
    
    'Close Connection & RecordSet
    Set dbRecSet = Nothing
    dbConn.Close
    Set dbConn = Nothing
End Sub

Make sure that the MDB database Table has correct field names as specified in the query. Also it has enough data.

Note: Before executing this code, from your VB Edifor go to Tools in the menu -> References & add a reference to “Microsoft ActiveX Data Objects Library”. This is to make sure that ADODB object can be created from within the VBA Macro code.

The loop after that is present after the recordset.open command will get records from the table one by one, till end of the table. Make sure the replace the msgbox command with some assignment. If not you will end up in giving too many ‘OK’ clicks for the message box that pops up for every record fetch.

Apart from recordset.Movenext, there are other commands available to move the cursor or current position to First or last record or to any desired point as well.

In the next tutorial, we will see how to query Access database & load them to a list box in userform.