[VBA] Ошибка при выполнении запроса ADO в MS Access со связанной таблицей - PullRequest
0 голосов
/ 25 марта 2011

Ошибка # -2147467259 ODBC - сбой вызова.(Источник: Microsoft JET Database Engine) (Состояние SQL: 3146) (NativeError: -532940753) Файл справки недоступен

Что случилось?В чем причина этого? Я могу сделать запрос к другому серверу sql через связанную таблицу odbc (uat env), но когда я иду на сервер 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

1 Ответ

2 голосов
/ 25 марта 2011

Наиболее распространенная причина этой ошибки - неправильные разрешения для папки, содержащей базу данных Access.Вам нужно будет установить права на запись.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...