[VBA]使用鏈接表在MS Access中進行ADO查詢時出錯

錯誤＃-2147467259 ODBC - 調用失敗。（來源：Microsoft Jet數據庫引擎）（SQL狀態：3146）（NativeError：-532940753）沒有可用的幫助文件[VBA]使用鏈接表在MS Access中進行ADO查詢時出錯

發生了什麼？這是什麼原因？ 我可以通過odbc鏈接表（uat env）對不同的sql服務器進行查詢，但是當我進入prod服務器時，出現這個錯誤。

我使用ms access 2000，並在其中構建了一個表單，然後在按下按鈕時向服務器發出查詢。 prod服務器得到了很多記錄，而uat服務器只有3000條記錄，但我不認爲這是一個問題...

感謝任何可能的幫助！

這是查詢的一部分：

Sub extractInboundCdr() 
On Error GoTo Error_Handling 
    Dim conConnection As New ADODB.Connection 
    Dim cmdCommand As New ADODB.Command 
    Dim rstRecordSet As New ADODB.Recordset 
    Dim Err As ADODB.Error 
    Dim strError As String 


    Dim eventPlanCode As String 
    Dim visitedCountry As String 
    Dim startDateTxt As String 
    Dim startDate As Date 
    Dim endDate As Date 
    Dim imsi As String 
    Dim currentMonth As String 
    Dim nextMonth As String 
    Dim currentYear As String 
    Dim nextYear As String 
    Dim temp As Integer 
    Dim i As Integer 
    Dim j As Integer 

    With conConnection 
    .Provider = "Microsoft.Jet.OLEDB.4.0" 
    .ConnectionString = CurrentDb.Name 
    .Open 
    End With 
    conConnection.CommandTimeout = 0 

    With cmdCommand 
    .ActiveConnection = conConnection 
    .CommandText = "SELECT * FROM Opt_In_Customer_Record;" 
    .CommandType = adCmdText 
    End With 

    With rstRecordSet 
    .CursorType = adOpenStatic 
    .CursorLocation = adUseClient 
    .LockType = adLockOptimistic 
    .Open cmdCommand 
    End With 

    If rstRecordSet.EOF = False Then 
     rstRecordSet.MoveFirst 
     Do 
      eventPlanCode = rstRecordSet!Event_Plan_Code 
      visitedCountry = rstRecordSet!Visited_Country 
      startDateTxt = rstRecordSet!start_date 
      imsi = rstRecordSet!imsi 
      currentMonth = Mid$(startDateTxt, 1, 3) 
      currentYear = Mid$(startDateTxt, 8, 4) 


      nextMonth = "" 
      If (currentMonth = "Jan") Then 
       currentMonth = "01" 
       nextMonth = "02" 
      ElseIf (currentMonth = "Feb") Then 
       currentMonth = "02" 
       nextMonth = "03" 
      ElseIf (currentMonth = "Mar") Then 
       currentMonth = "03" 
       nextMonth = "04" 
      ElseIf (currentMonth = "Apr") Then 
       currentMonth = "04" 
       nextMonth = "05" 
      ElseIf (currentMonth = "May") Then 
       currentMonth = "05" 
       nextMonth = "06" 
      ElseIf (currentMonth = "Jun") Then 
       currentMonth = "06" 
       nextMonth = "07" 
      ElseIf (currentMonth = "Jul") Then 
       currentMonth = "07" 
       nextMonth = "08" 
      ElseIf (currentMonth = "Aug") Then 
       currentMonth = "08" 
       nextMonth = "09" 
      ElseIf (currentMonth = "Sep") Then 
       currentMonth = "09" 
       nextMonth = "10" 
      ElseIf (currentMonth = "Oct") Then 
       currentMonth = "10" 
       nextMonth = "11" 
      ElseIf (currentMonth = "Nov") Then 
       currentMonth = "11" 
       nextMonth = "12" 
      ElseIf (currentMonth = "Dec") Then 
       currentMonth = "12" 
       nextMonth = "01" 
      Else 
       GoTo Error_Handling 
      End If 

      temp = Val(currentYear) 
      temp = temp + 1 
      nextYear = CStr(temp) 

      Exit Do 
     Loop Until rstRecordSet.EOF = True 
    End If 


    Set cmdCommand = Nothing 
    Set rstRecordSet = Nothing 
    Set connConnection = Nothing 

    With conConnection 
    .Provider = "Microsoft.Jet.OLEDB.4.0" 
    .ConnectionString = CurrentDb.Name 
    .Open 
    End With 
    conConnection.CommandTimeout = 0 

    Dim thisMonthTable As String 
    Dim nextMonthTable As String 

    thisMonthTable = "dbo_inbound_rated_all_" & currentYear & currentMonth 

    If (currentMonth = "12") Then 
     nextMonthTable = "dbo_inbound_rated_all_" & nextYear & nextMonth 
    Else 
     nextMonthTable = "dbo_inbound_rated_all_" & currentYear & nextMonth 
    End If 

    With cmdCommand 
    .ActiveConnection = conConnection 
    .CommandText = "(SELECT A.IMSI_NUMBER, A.CALL_DATE, A.CALL_TIME, A.VOL_KBYTE, A.TOTAL_CHARGE ,datevalue(A.call_date), A.Service_Code As theDate FROM " & thisMonthTable & " AS A INNER JOIN Opt_In_Customer_Record AS B on A.imsi_number = B.imsi where A.Service_Code = 'GPRS' and Datevalue(A.call_date) >= Datevalue(B.start_date) And Datevalue(A.call_date) < (Datevalue(B.start_date) + val(LEFT(B.event_plan_code, 1)))) " & _ 
        "UNION " & _ 
        "(SELECT A.IMSI_NUMBER, A.CALL_DATE, A.CALL_TIME, A.VOL_KBYTE, A.TOTAL_CHARGE ,datevalue(A.call_date), A.Service_Code As theDate FROM " & nextMonthTable & " AS A INNER JOIN Opt_In_Customer_Record AS B on A.imsi_number = B.imsi where A.Service_Code = 'GPRS' and Datevalue(A.call_date) >= Datevalue(B.start_date) And Datevalue(A.call_date) < (Datevalue(B.start_date) + val(LEFT(B.event_plan_code, 1)))) " & _ 
        "Order by A.IMSI_NUMBER, theDate" 
    .CommandType = adCmdText 
    End With 

    With rstRecordSet 
    .CursorType = adOpenStatic 
    .CursorLocation = adUseClient 
    .LockType = adLockReadOnly 
    .Open cmdCommand 
    End With 


    If rstRecordSet.EOF = False Then 
     rstRecordSet.MoveFirst 
     Do 
      Dim sql As String 
      sql = "insert into IB_CDR values (" 

      For j = 0 To rstRecordSet.Fields.Count - 3 '''''Last 2 fields is not inserted 
       If (j = 3 Or j = 4) Then '''''These fields are number 
        sql = sql & rstRecordSet.Fields(j) & "," 
       Else 
        sql = sql & "'" & rstRecordSet.Fields(j) & "'," 
       End If 
      Next 


      sql = Left(sql, Len(sql) - 1) '''''Remove the last ',' 
      sql = sql & ");" 

      CurrentDb.Execute sql 

      rstRecordSet.MoveNext 

     Loop Until rstRecordSet.EOF = True 
    End If 



    conConnection.Close 
    Set conConnection = Nothing 
    Set cmdCommand = Nothing 
    Set rstRecordSet = Nothing 

    Exit Sub 

Error_Handling: 
For Each Err In conConnection.Errors 
     strError = "Error #" & Err.Number & vbCr & _ 
      " " & Err.Description & vbCr & _ 
      " (Source: " & Err.Source & ")" & vbCr & _ 
      " (SQL State: " & Err.SQLState & ")" & vbCr & _ 
      " (NativeError: " & Err.NativeError & ")" & vbCr 
     If Err.HelpFile = "" Then 
      strError = strError & " No Help file available" 
     Else 
      strError = strError & _ 
       " (HelpFile: " & Err.HelpFile & ")" & vbCr & _ 
       " (HelpContext: " & Err.HelpContext & ")" & _ 
       vbCr & vbCr 
     End If 

     Debug.Print strError 
    Next 

    Resume Next 
Set conConnection = Nothing 
Set cmdCommand = Nothing 
Set rstRecordSet = Nothing 
Exit Sub 

End Sub

來源

2011-03-25 lamwaiman1988