Excel VBA ADOループ

Question

私の質問は簡単かもしれませんが、私は適切な解決策を見つけるのに苦労しています。

私はADO接続を使用して、

そして、ユニークな6桁のIDが列Aを満たしている最初のものでは、Excelスプレッドシートのカップルを持って、私はこれらのユニークなIDのそれぞれに対応した情報を取得する必要があります

これまでのところ、私は以下のコードを実装していますが、これは最善の方法ではないと確信しています（遅くても）

確かに、私はADOなしでこれを行うVBAルーチンを持っていますが、情報量はますます大きくなり、間もなく問題になる。希望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

は、任意のループを回避し、単にWindowsのジェット/ ACEエンジンとしてSQLの両方でワークブックを接続して考えてみましょうおかげでさえ、Excelブック、Accessデータベースのインライン照会することができますテキストファイル。

は以下のSheet1という名前のワークシートに（そうでない場合は、SQLのSELECTとON条項を変更する）固有のIDの主なワークブックであなたの列ヘッダが列1という前提にしています。さらに、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" _ 

[Labinal]第二に、この行でExcel

に名前付き範囲（テーブル）を指す：

sSQLSting = "SELECT t2.[CurrentPhase]" _ 

あなたは、あなたが戻ったいデータを選択し、この場合、私はここで私はデータベースとして使用するExcelファイルに「現在のフェーズ」という名前の列（「Labinal」などの範囲名に含まれる）

にそれを減らします最終的なコード：

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