Excel VBA ADO循環

Question

我的問題可能很簡單，但我無法找到合適的解決方案。

我有幾個Excel電子表格中，在第一個我也有獨特的6個位數的ID填補了A列

然後，使用ADO連接，我需要獲得對應於每個唯一ID的信息從第二個電子表格（其中包含大量的數據）

到目前爲止我執行下面的代碼，但我很確定這不是最好的或最快的方式來做到這一點（因爲它非常慢）

當然，我有一個VBA例程，這將做到這一點沒有ADO，但信息量越來越大，很快它會成爲一個問題。

希望ADO可以幫我管理它，謝謝

Sub UpdateCurrentStatus() 
    Dim sSQLQry As String 
    Dim ReturnArray 
    Dim Conn As New ADODB.Connection 
    Dim mrs As New ADODB.Recordset 
    Dim DBPath As String, sconnect As String 
    Dim UID As String 


    If MsgBox("Is the Labinal extract up-to-date?", vbYesNo) = vbNo Then Exit Sub 

    Application.ScreenUpdating = False 

    DBPath = Application.GetOpenFilename(Title:="Select second spreadsheet", FileFilter:="CSV (Comma delimited) (*.csv), *.csv") 

    sconnect = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & DBPath & ";HDR=Yes';FMT=Delimited(;)" 
    Conn.Open sconnect 

    y = 2 
    Do 
     UID = ThisWorkbook.Worksheets("Sheet1").Cells(y, 1).Value 

     sSQLSting = "SELECT [CurrentPhase] From [LabinalExtract$] where TicketReference =" & UID ' Your SQL Statement (Table Name= Sheet Name=[Sheet1$])" 

     mrs.Open sSQLSting, Conn 

     Sheets(1).Range("B2").CopyFromRecordset mrs 

     mrs.Close 

     y = y + 1 

    Loop While ThisWorkbook.Worksheets("Sheet1").Cells(y, 1) <> "" 

    Conn.Close 

End Sub 

Answer 1

考慮避免任何循環，只是在SQL連接這兩個工作簿作爲Windows的噴氣/ ACE引擎允許的Excel工作簿，Access數據庫的在線查詢，甚至文本文件。

以下假設中唯一ID的主要工作簿的列標頭名爲列1命名工作表Sheet1 工作（否則更改SQL的SELECT和ON條款）。另外還不清楚您是否連接到CSV文件或Excel工作簿。這假設都是Excel工作簿。

' CURRENT WORKBOOK CONNECTION (LAST SAVED STATE) 
xlConn.Open "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _ 
       & "DBQ=" & ThisWorkbook.FullName & ";" 

' JOIN QUERY WITH INLINE EXTERNAL CONNECTION 
sSQLSting = "SELECT t1.Column1, t2.[CurrentPhase]" _ 
       & " FROM [Sheet1$] t1" _ 
       & " INNER JOIN" _ 
       & "  (SELECT * FROM" _ 
       & "  [Excel 12.0 Xml;HDR=Yes;Database=" & DBPath & "].[LabinalExtract$]) t2" _ 
       & " ON t1.Column1 = t2.TicketReference" 

' OUTPUT QUERY RESULTS 
mrs.Open sSQLSting, xlConn 

Sheets(1).Range("B2").CopyFromRecordset mrs 

mrs.Close 
xlConn.Close 

Answer 2

試試這個。使用子程序。

Sub myQuery() 
Dim y As Integer 
y = 2 
Do 
    UID = ThisWorkbook.Worksheets("Sheet1").Cells(y, 1).Value 

    sSQLSting = "SELECT [CurrentPhase] From [LabinalExtract$] where TicketReference =" & UID ' Your SQL Statement (Table Name= Sheet Name=[Sheet1$])" 
    y = y + 1 

Loop While ThisWorkbook.Worksheets("Sheet1").Cells(y, 1) <> "" 

End Sub 
Sub UpdateCurrentStatus(sSQLQry As String) 
'Dim sSQLQry As String 
Dim ReturnArray 
Dim Conn As New ADODB.Connection 
Dim mrs As New ADODB.Recordset 
Dim DBPath As String, sconnect As String 
Dim UID As String 


If MsgBox("Is the Labinal extract up-to-date?", vbYesNo) = vbNo Then Exit Sub 
Application.ScreenUpdating = False 


DBPath = Application.GetOpenFilename(Title:="Select second spreadsheet", FileFilter:="CSV (Comma delimited) (*.csv), *.csv") 

sconnect = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & DBPath & ";HDR=Yes';FMT=Delimited(;)" 
Conn.Open sconnect 

    mrs.Open sSQLSting, Conn 

    Sheets(1).Range("B" & Rows.Count).End(xlUp)(2).CopyFromRecordset mrs 

    mrs.Close 

    Set mrs = Nothing 
Conn.Close 

End Sub 

Answer 3

我設法成功適應由芭菲好心提供的代碼，現在正在工作，希望它可以幫助別人

要小心，因爲在該行：

& "  [Excel 12.0 Xml;HDR=Yes;Database=" & DBPath & "].[Labinal]) t2" _ 

[拉比納]指Excel中的一個命名範圍（表格）

其次在此行中：

sSQLSting = "SELECT t2.[CurrentPhase]" _ 

你選擇要回數據，在這種情況下，我將其降低到在我作爲數據庫中的Excel文件名爲「當前階段」列（包括在區域名稱爲「拉比納公司」）

這裏最終代碼：

Sub UpdateCurrentStatus() 
    Dim sSQLQry, sSQLSting As String 
    Dim ReturnArray 
    Dim Conn As New ADODB.Connection 
    Dim mrs As New ADODB.Recordset 
    Dim DBPath As String, sconnect As String 

    If MsgBox("Is the Labinal extract up-to-date?", vbYesNo) = vbNo Then Exit Sub 

    'Application.ScreenUpdating = False 

    DBPath = Application.GetOpenFilename(Title:="Selecciona el extracto de iMade", FileFilter:="Excel files (*.xlsx), *.xlsx") 


    ' CURRENT WORKBOOK CONNECTION (LAST SAVED STATE) 
    Conn.Open "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _ 
       & "DBQ=" & ThisWorkbook.FullName & ";" 

    ' JOIN QUERY WITH INLINE EXTERNAL CONNECTION 
    sSQLSting = "SELECT t2.[CurrentPhase]" _ 
       & " FROM [Sheet1$] t1" _ 
       & " INNER JOIN" _ 
       & "  (SELECT * FROM" _ 
       & "  [Excel 12.0 Xml;HDR=Yes;Database=" & DBPath & "].[Labinal]) t2" _ 
       & " ON t1.Column1 = t2.TicketReference" 

    ' OUTPUT QUERY RESULTS 
    mrs.Open sSQLSting, Conn 

    Sheets(1).Range("B2").CopyFromRecordset mrs 

mrs.Close 
Conn.Close 


End Sub