標題: [分享] 在 thisworkbook 運用ADO找資料 [打印本頁]

---

作者: mhl9mhl9    時間: 2013-7-15 21:32     標題: 在 thisworkbook 運用ADO找資料

在thisworkbook里,用ADO尋找資料

Dim iQ As String
Dim iAddress As Range

Sub iSql()
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Set cn = New ADODB.Connection
    Set rs = New ADODB.Recordset
   
    Dim strDataSrcXlsPath As String
    Dim strQuery As String
    Dim rStartCell  As Range
   
    strDataSrcXlsPath = ThisWorkbook.FullName
    strQuery = iQ
    Set rStartCell = iAddress
   
    If Application.Version < 12 Then
        cn.ConnectionString = _
          "Provider=Microsoft.Jet.OLEDB.4.0;" & _
          "Data Source=" & strDataSrcXlsPath & ";" & _
          "Extended Properties=Excel 8.0"
    Else
        cn.ConnectionString = _
          "Provider=Microsoft.ACE.OLEDB.12.0;" & _
          "Data Source=" & strDataSrcXlsPath & ";" & _
          "Extended Properties=Excel 8.0"
    End If
   
    cn.Open
    Set rs = cn.Execute(iQ)
        
    With Sheets(rStartCell.Parent.Name)
        .Cells.ClearContents
        
        Dim strStartlocation As String
        Dim lngColCounter As Long
        For lngColCounter = 0 To rs.Fields.Count - 1
            rStartCell.Offset(0, lngColCounter) = rs.Fields(lngColCounter).Name
        Next lngColCounter
        rStartCell.Offset(1).CopyFromRecordset rs
    End With

linex:
    cn.Close
    Set cn = Nothing
    Set rs = Nothing
End Sub

Sub Test()
    iQ = "select * from [資料庫$]"       '''''''你的資料在sheets("資料庫")里
    Set iAddress = Sheets("sheet4").Range("A1")    '''找到的資料放在sheet4.cells(1,1)
    iSql
End Sub

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)