VBA/Excel/Access/Word/Excel/Excel ADO

Материал из VB Эксперт
Перейти к: навигация, поиск

Excel based database

 
Sub ExcelExample()
    Dim r As Integer, f As Integer
    Dim vrecs As Variant
    Dim rs As ADODB.Recordset
    Dim cn As ADODB.Connection
    Dim fld As ADODB.Field
    Set cn = New ADODB.Connection
    cn.Provider = "Microsoft OLE DB Provider for ODBC Drivers"
    cn.ConnectionString = "DRIVER={Microsoft Excel Driver (*.xls)};DBQ=C:\mydb.mdb;"
    cn.Open
    Debug.Print cn.ConnectionString
    Set rs = New ADODB.Recordset
    rs.CursorLocation = adUseClient
    rs.Open "SELECT * FROM Employees", cn, adOpenDynamic, adLockOptimistic
    For Each fld In rs.Fields
        Debug.Print fld.Name,
    Next
    Debug.Print
    vrecs = rs.GetRows(6)
    For r = 0 To UBound(vrecs, 1)
        For f = 0 To UBound(vrecs, 2)
            Debug.Print vrecs(f, r),
        Next
        Debug.Print
    Next
    Debug.Print "adAddNew: " & rs.Supports(adAddNew)
    Debug.Print "adBookmark: " & rs.Supports(adBookmark)
    Debug.Print "adDelete: " & rs.Supports(adDelete)
    Debug.Print "adFind: " & rs.Supports(adFind)
    Debug.Print "adUpdate: " & rs.Supports(adUpdate)
    Debug.Print "adMovePrevious: " & rs.Supports(adMovePrevious)
    
    rs.Close
    cn.Close
    
End Sub



Insert a row to a worksheet by using the SQL statement

 
Public Sub WorksheetInsert()
  Dim Connection As ADODB.Connection
  Dim ConnectionString As String
  ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.Path & "\Sales.xls;" & _
    "Extended Properties=Excel 8.0;"
    
  Dim SQL As String
    
  SQL = "INSERT INTO [Sales$] VALUES("VA", "On", "Computers", "Mid", 30)"
  Set Connection = New ADODB.Connection
  Call Connection.Open(ConnectionString)
    
  Call Connection.Execute(SQL, , CommandTypeEnum.adCmdText Or ExecuteOptionEnum.adExecuteNoRecords)
  Connection.Close
  Set Connection = Nothing
End Sub



Opening an Excel Spreadsheet with ADO

 
Sub Open_ExcelSpread()
   Dim conn As ADODB.Connection
   Set conn = New ADODB.Connection
   conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
       "Data Source=" & CurrentProject.Path & _
       "\Report.xls;" & _
       "Extended Properties=Excel 8.0;"
   conn.Close
   Set conn = Nothing
End Sub



Use ADO to read the data from Access database to Excel

 
Public Sub SavedQuery()
    
  Dim Field As ADODB.Field
  Dim Recordset As ADODB.Recordset
  Dim Offset As Long
    
  Const ConnectionString As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\mydb.mdb;Persist Security Info=False"
    
  Set Recordset = New ADODB.Recordset
  Call Recordset.Open("[Sales By Category]", ConnectionString, _
    CursorTypeEnum.adOpenForwardOnly, LockTypeEnum.adLockReadOnly, _
    CommandTypeEnum.adCmdTable)
  If Not Recordset.EOF Then
    With Sheet1.Range("A1")
      For Each Field In Recordset.Fields
        .Offset(0, Offset).Value = Field.Name
        Offset = Offset + 1
      Next Field
      .Resize(1, Recordset.Fields.Count).Font.Bold = True
    End With
    Call Sheet1.Range("A2").CopyFromRecordset(Recordset)
    Sheet1.UsedRange.EntireColumn.AutoFit
  Else
    Debug.Print "Error: No records returned."
  End If
  Recordset.Close
  Set Recordset = Nothing
End Sub