2014-10-17 85 views
-1

我有2個項目列表,1個是客戶端ID,另一個是國家保險號,並且被要求創建一個聰明的SUB,它將檢查ID和NI的數據庫,以及if theres結果複製數據,如果沒有結果嘗試ID,如果沒有運氣與ID嘗試NI作爲最後的手段 我已經試過這與下面的代碼,開始查詢基於當前單元格ID和NI查找信息,如果結果複製到單元格和完成,如果沒有結果做相同的查詢,但只是與ID如果結果複製其他嘗試NI等。VBA在嵌套的條件語句中更改SQL語句

我不斷收到記錄集錯誤,不允許它被用於打開,但ive添加在每種情況之後關閉,但仍然沒有結果。

這種想法可行,如果是缺少什麼來回我的代碼爲它做我想做什麼做

Dim con As ADODB.Connection 
Dim rec As ADODB.Recordset 
Set con = New ADODB.Connection 
Set rec = New ADODB.Recordset 

Dim sql As String 
Dim client As String 
Dim NI As String 

Dim myRange As Range 
Dim myCell As Range 
Dim msgStr As Variant 
Dim f As New Details_Bar 

Set myRange = Range("A2:A502") 

Dim x As Integer 
x = 1 
pos = 2 

With con 
    .Provider = "MSDASQL" 
    .ConnectionString = "DSN=ukfast" 
    .Open 
End With 

' Loop Start 
For Each myCell In myRange 

client = myCell.text 
NI = Cells(myCell.Row, 2).text 

    ' First Look 
    sql = "SELECT id,firstname,lastname,national_insurance FROM crm_clients WHERE id = '" & client & "' AND national_insurance = '" & NI & "' GROUP BY id" 

    rec.Open sql, con 
    ' If Record Found Auto Enter Data in cells 
    If Not (rec.BOF And rec.EOF) Then 

    Cells(myCell.Row, 7).CopyFromRecordset rec 

    rec.Close 

    MSG1 = MsgBox("Data Was Automatically Found", vbOKOnly) 

    'Else Begin to query the database again based on the Client ID 

    Else 

     sql = "SELECT id,firstname,lastname,national_insurance FROM crm_clients WHERE id = '" & client & "' GROUP BY id" 

     rec.Open sql, con 

     'If no result on ID then try NI Number 

      If (rec.BOF And rec.EOF) Then 

       sql = "SELECT id,firstname,lastname,national_insurance FROM crm_clients WHERE national_insurance = '" & NI & "' GROUP BY id" 

       rec.Open sql, con 

       Cells(myCell.Row, 100).CopyFromRecordset rec 

       MSG1 = MsgBox("The Following Data Was Found About Client based on NI" & x & vbNewLine & "Client ID : " & Cells(myCell.Row, 100) & vbNewLine & "First Name : " & Cells(myCell.Row, 101) & vbNewLine & "Last Name : " & Cells(myCell.Row, 102) & vbNewLine & "National Insurance : " & Cells(myCell.Row, 103) & vbNewLine & "Is this correct?", vbYesNoCancel, "Data Check") 

       Select Case MSG1 

       Case vbYes 
        Cells(myCell.Row, "G").Value = Cells(myCell.Row, 100) 
        Cells(myCell.Row, "H").Value = Cells(myCell.Row, 101) 
        Cells(myCell.Row, "I").Value = Cells(myCell.Row, 102) 
        Cells(myCell.Row, "J").Value = Cells(myCell.Row, 103) 
       Case vbNo 
        Details_Bar.Show 
       Case vbCancel 
        Exit For 
        Exit Sub 

       End Select 
       rec.Close 
      End If 

     Cells(myCell.Row, 100).CopyFromRecordset rec 

     MSG1 = MsgBox("The Following Data Was Found About Client based on ID" & x & vbNewLine & "Client ID : " & Cells(myCell.Row, 100) & vbNewLine & "First Name : " & Cells(myCell.Row, 101) & vbNewLine & "Last Name : " & Cells(myCell.Row, 102) & vbNewLine & "National Insurance : " & Cells(myCell.Row, 103) & vbNewLine & "Is this correct?", vbYesNoCancel, "Data Check") 

      Select Case MSG1 

      Case vbYes 
       Cells(myCell.Row, "G").Value = Cells(myCell.Row, 100) 
       Cells(myCell.Row, "H").Value = Cells(myCell.Row, 101) 
       Cells(myCell.Row, "I").Value = Cells(myCell.Row, 102) 
       Cells(myCell.Row, "J").Value = Cells(myCell.Row, 103) 
      Case vbNo 
       Details_Bar.Show 
      Case vbCancel 
       Exit For 
       Exit Sub 

      End Select 
     rec.Close 
End If 


' Update Vars 
pos = pos + 1 
x = x + 1 
'End Of Loop 
Next myCell 

GUI.CommandButton13.Enabled = False 
GUI.CommandButton15.Enabled = False 
Range("CA502:CZ502").Select 
Selection.Delete 
Range("A1").Select 

回答

1

想出解決方案。

就像我之前的一些工作一樣,我意識到記錄需要在循環結束之前始終關閉,並且每條不同的條件語句都必須在每個條件語句的開始處關閉,並立即在新查詢後重新打開,然後在所有條件語句之外關閉

' First Look 
    sql = "SELECT id,firstname,lastname,national_insurance FROM crm_clients WHERE id = '" & client & "' AND national_insurance = '" & NI & "' GROUP BY id" 

    rec.Open sql, con 
    ' If Record Found Auto Enter Data in cells 
    If Not (rec.BOF And rec.EOF) Then 

    Cells(myCell.Row, 7).CopyFromRecordset rec 

    rec.Close '<--------------- Previous location 

    MSG1 = MsgBox("Data Was Automatically Found", vbOKOnly) 

    'Else Begin to query the database again based on the Client ID 

    Else 
     rec.close <-------------- New location 

     sql = "SELECT id,firstname,lastname,national_insurance FROM crm_clients WHERE id = '" & client & "' GROUP BY id" 

     rec.Open sql, con