■■■■用adodb如何访问xls电子表文件，在线急等

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
                   (ByVal hwnd As Long, ByVal lpszOp As String, _
                    ByVal lpszFile As String, ByVal lpszParams As String, _
                    ByVal LpszDir As String, ByVal FsShowCmd As Long) _
                    As Long
Private Const SW_NORMAL = 1Private sNwind As String            'Path to sample Access database
Private sOrdersTemplate As String   'Path to Orders Workbook "Template"
Private sEmpDataTemplate As String  'Path to Employee Data Workbook "Template"
Private sProductsTemplate As String 'Path to Products Workbook "Template"
Private sChartTemplate As String    'Path to Workbook "Template" containing a chart
Private sSourceData As StringPrivate Sub Form_Load()
    'Initialize the paths to the various workbooks that the
    'samples will use.
    sNwind = App.Path & "\data.mdb"
    sOrdersTemplate = App.Path & "\OrdersTemplate.xls"
    sEmpDataTemplate = App.Path & "\EmpDataTemplate.xls"
    sProductsTemplate = App.Path & "\ProductsTemplate.xls"
    sChartTemplate = App.Path & "\ChartingTemplate.xls"
    sSourceData = App.Path & "\SourceData.xls"
End SubPrivate Sub cmdSample1_Click()

    'Make a copy of the workbook template
    FileCopy sOrdersTemplate, App.Path & "\Results\Orders1.xls"

    'Open the ADO connection to the Excel workbook
    Set oConn = New ADODB.Connection
    oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
               "Data Source=" & App.Path & "\Results\Orders1.xls;" & _
               "Extended Properties=""Excel 8.0;HDR=NO;"""    'Open a connection to the Northwind database and retrieve the information
    'in OrderDetails table
    Dim oNWindConn As New ADODB.Connection, oOrdersRS As New ADODB.Recordset
    oNWindConn.Open "provider=microsoft.jet.oledb.4.0; data source=" & sNwind

    oOrdersRS.Open "SELECT [Order Details].OrderID, Products.ProductName, " & _
                   "[Order Details].UnitPrice , [Order Details].Quantity, " & _
                   "[Order Details].Discount FROM Products INNER JOIN " & _
                   "[Order Details] ON Products.ProductID = " & _
                   "[Order Details].ProductID ORDER BY [Order Details].OrderID", _
                   oNWindConn, adOpenStatic

    '**Note: The first "row" in the Orders_Table is hidden -- it contains dummy data that
    '        the OLE DB Provider uses to determine the data types for the table.

    'Add the data from the Order Details table in Northwind to the workbook
    Dim oRS As New ADODB.Recordset
    oRS.Open "Select * from Orders_Table", oConn, adOpenKeyset, adLockOptimistic

    Do While Not (oOrdersRS.EOF)
        oRS.AddNew
        For i = 0 To 4
            oRS.Fields(i).Value = oOrdersRS.Fields(i).Value
        Next
        oRS.Update
        oOrdersRS.MoveNext
    Loop

    'Close the recordset and connection to Northwind
    oOrdersRS.Close
    Set oOrdersRS = Nothing
    oNWindConn.Close
    Set oNWindConn = Nothing

    'Close the connection to the workbook
    oConn.Close
    Set oConn = Nothing

    'Open the workbook to examine the results
    DoEvents
    ShellExecute Me.hwnd, "Open", App.Path & "\Results\Orders1.xls", "", "C:\", SW_SHOWNORMAL

End SubPrivate Sub cmdSample2_Click()    'Make a copy of the workbook template
    FileCopy sEmpDataTemplate, App.Path & "\Results\EmpData.xls"

    'Open the ADO connection to the Excel workbook
    Set oConn = New ADODB.Connection
    oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
               "Data Source=" & App.Path & "\Results\EmpData.xls;" & _
               "Extended Properties=""Excel 8.0;HDR=NO;"""

    'Add values to individual cells
    oConn.Execute "Insert into First_Name (F1) Values ('Nancy')"
    oConn.Execute "Insert into Last_Name (F1) Values ('Davolio')"
    oConn.Execute "Insert into Title (F1) Values ('Sales Manager')"
    oConn.Execute "Insert into Hire_Date (F1) Values (#11/1/00#)"
    oConn.Execute "Insert into Comments (F1) Values ('This is a line of long text that will wrap in the cell.This is a line of long text that will wrap in the cell.')"

    'Close the connection
    oConn.Close

    'Open the workbook to examine the results
    DoEvents
    ShellExecute Me.hwnd, "Open", App.Path & "\Results\EmpData.xls", "", "C:\", SW_SHOWNORMAL

End SubPrivate Sub cmdSample3_Click()    'Make a copy of the workbook template
    FileCopy sProductsTemplate, App.Path & "\Results\Products.xls"

    'Open a connection to the Northwind database and retrieve the information
    'in the Products table
    Dim oNWindConn As New ADODB.Connection, oProdRS As New ADODB.Recordset
    oNWindConn.Open "provider=microsoft.jet.oledb.4.0; data source=" & sNwind
    oProdRS.Open "SELECT Products.ProductName," & _
                 "Products.UnitPrice, Products.UnitsInStock FROM Products", _
                 oNWindConn, adOpenStatic    'Open the ADO connection to the Excel workbook
    Dim oConn As ADODB.Connection
    Set oConn = New ADODB.Connection
    oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
               "Data Source=" & App.Path & "\Results\Products.xls;" & _
               "Extended Properties=""Excel 8.0;HDR=NO;"""

    'Create a new table (or worksheet in the workbook)
    oConn.Execute "create table Products (Product char(255), UnitPrice int, UnitsInStock int)"    Dim oRS As ADODB.Recordset
    Set oRS = New ADODB.Recordset
    oRS.Open "Select * from Products", oConn, adOpenKeyset, adLockOptimistic

    Do While Not (oProdRS.EOF)
        oRS.AddNew
        oRS.Fields(0) = oProdRS.Fields("ProductName").Value
        oRS.Fields(1) = oProdRS.Fields("UnitPrice").Value
        oRS.Fields(2) = oProdRS.Fields("UnitsInStock").Value
        oRS.Update
        oProdRS.MoveNext
    Loop

    'Close the recordset and connection to Northwind
    oProdRS.Close
    oNWindConn.Close

    'Close the recordset and connection to the Excel workbook
    oRS.Close
    oConn.Close

    'Open the workbook to examine the results
    DoEvents
    ShellExecute Me.hwnd, "Open", App.Path & "\Results\Products.xls", "", "C:\", SW_SHOWNORMAL

End Sub

Private Sub cmdSample4_Click()   'Make a copy of the workbook template
   FileCopy sOrdersTemplate, App.Path & "\Results\Orders2.xls"   Dim catDB As ADOX.Catalog
   Dim tblLink As ADOX.Table   Set catDB = New ADOX.Catalog   'Link the Orders_Table in the Workbook to the Access Northwind Database.
   'The name of the linked, or attached table, in NorthWind will be "LinkedXLS"
   catDB.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
         "Data Source=" & sNwind
   Set tblLink = New ADOX.Table
   With tblLink
      .Name = "LinkedXLS"
      Set .ParentCatalog = catDB
      .Properties("Jet OLEDB:Create Link") = True
      .Properties("Jet OLEDB:Link Provider String") = _
            "Excel 8.0;DATABASE=" & App.Path & "\Results\Orders2.xls;HDR=NO"
      .Properties("Jet OLEDB:Remote Table Name") = "Orders_Table"
   End With
   catDB.Tables.Append tblLink


   'Open a connection to Northwind
   Dim oConn As New ADODB.Connection
   oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
         "Data Source=" & sNwind

   'Append the records from a join between [Order Details] and [Products] into the
   'linked Excel table
   oConn.Execute "INSERT INTO LinkedXLS ( F1, F2, F3, F4, F5 ) " & _
                 "SELECT [Order Details].OrderID, Products.ProductName, " & _
                 "[Order Details].UnitPrice, [Order Details].Quantity, " & _
                 "[Order Details].Discount FROM Products INNER JOIN " & _
                 "[Order Details] ON Products.ProductID = [Order Details].ProductID"

   'Detach the table and close the connection
   catDB.Tables.Delete "LinkedXLS"
   Set tblLink = Nothing
   oConn.Close
   Set catDB = Nothing

    'Open the workbook to examine the results
    DoEvents
    ShellExecute Me.hwnd, "Open", App.Path & "\Results\Orders2.xls", "", "C:\", SW_SHOWNORMAL

End SubPrivate Sub cmdSample5_Click()

    If cboTables.ListIndex < 0 Then
        MsgBox "Select a table from the list"
        Exit Sub
    End If

    'Open the ADO connection to the Excel workbook
    Dim oConn As ADODB.Connection
    Set oConn = New ADODB.Connection
    oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
               "Data Source=" & sSourceData & ";" & _
               "Extended Properties=""Excel 8.0;HDR=YES;"""

    'Get the table name from the dropdown
    Dim sTableName As String
    sTableName = "[" & cboTables.List(cboTables.ListIndex) & "]"

    'Get the recordset
    Dim oRS As ADODB.Recordset, nCols As Integer
    Set oRS = New ADODB.Recordset
    oRS.Open sTableName, oConn, adOpenStatic, adLockOptimistic
    nCols = oRS.Fields.Count

    Debug.Print sTableName    'Display the field names
    Dim i As Integer, sFields As String, sData As String
    For i = 0 To nCols - 1
        sFields = sFields & oRS.Fields(i).Name & vbTab
    Next
    Debug.Print sFields

    'Display the records
    Do While Not oRS.EOF
        sData = ""
        For i = 0 To nCols - 1
            sData = sData & oRS.Fields(i).Value & vbTab
        Next
        Debug.Print sData
        oRS.MoveNext
    Loop

    'Close the recordset and the connection
    oRS.Close
    oConn.Close

End Sub

Dim cN As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim a() As String
    Set cN = New ADODB.Connection

     cN.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\data\_data.mdb;Persist Security Info=False;jet OLEDB:Database password=422127197509080072"
    cN.Open访问xls用以上的方法行不行？我不想这么复杂

Dim oConn As ADODB.Connection
    Set oConn = New ADODB.Connection
    oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
               "Data Source=" & sSourceData & ";" & _
               "Extended Properties=""Excel 8.0;HDR=YES;"""你把连接字串改一下！

Public Function Read_Excel _
         (ByVal sFile _
          As String) As ADODB.Recordset      On Error GoTo fix_err
      Dim rs As ADODB.Recordset
      Set rs = New ADODB.Recordset
      Dim sconn As String      rs.CursorLocation = adUseClient
      rs.CursorType = adOpenKeyset
      rs.LockType = adLockBatchOptimistic      sconn = "DRIVER=Microsoft Excel Driver (*.xls);" & "DBQ=" & sFile
      rs.Open "SELECT * FROM [sheet1$]", sconn
      Set Read_Excel = rs
      Set rs = Nothing
      Exit Function
fix_err:
      Debug.Print Err.Description + " " + _
                  Err.Source, vbCritical, "Import"
      Err.Clear
End Function

调试易

■■■■用adodb如何访问xls电子表文件，在线急等

解决方案 »