[¤À¨É] ¦b thisworkbook ¹B¥ÎADO§ä¸ê®Æ

mhl9mhl9

¦bthisworkbook¨½,¥ÎADO´M§ä¸ê®Æ

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 [¸ê®Æ®w$]"       '''''''§Aªº¸ê®Æ¦bsheets("¸ê®Æ®w")¨½
    Set iAddress = Sheets("sheet4").Range("A1")    '''§ä¨ìªº¸ê®Æ©ñ¦bsheet4.cells(1,1)
    iSql
End Sub