День добрый.
Помогите, пожалуйста, с ошибкой Run-time error '-2147467259 (80004005)': Method 'CopyFromRecordset' of object 'Range' failed.
Очень прошу помочь ибо уже начинаю отчаиваться в поисках проблемы. Написал код, который выполняет выгрузку данных из базы данных Access в Excel согласно выбранным пользователем параметрам. Заранее приношу извинения за то, что привожу достаточно объемный код, но это исключительно для полноты картины.
Аргументы в процедуру передаются из пользовательской формы, в частности: начальный период, конечный период и страна.
Фишка в том, что ошибка Run-time error '-2147467259 (80004005)' проявляется, когда я пытаюсь выгрузить информацию по конкретным странам (в данном случае Бразилия),
и макрос прерывается на выгрузке определенной записи, которая ничем особенным от других не отличается. То есть, частично работает.
В запросе длинных полей (свыше 255 символов), полей MEMO нет. Пытался изменить формулы вычислений, но не помогло.
Посмотрите, пожалуйста, кто-нибудь опытным взглядом и укажите где собака зарыта. Возможно кто-то подскажет обходные пути, ведь в самом Ассеssе запрос формируется нормально.
Заранее благодарен за подсказки.
Sub RunCasePerCountry(Optional dPeriodFrom As Date = #7/1/2013#, Optional dPeriodTo As Date = #6/1/2014#, Optional stCountry As String = "Brazil", _
Optional stCurrency As String = "EUR", Optional stSaveAs As String, Optional bOpenReport = True)
Dim MyDatabase As DAO.Database
Dim MyRecordset As DAO.Recordset
Dim stPeriodFrom As String, stPeriodTo As String
Dim MyQuery As String
Dim i As Integer, c As Integer
Dim wrbReport As Workbook
Dim shtData As Worksheet, shtReport As Worksheet
stPeriodFrom = Month(dPeriodFrom) & "/" & Day(dPeriodFrom) & "/" & Year(dPeriodFrom)
stPeriodTo = Month(dPeriodTo) & "/" & Day(dPeriodTo) & "/" & Year(dPeriodTo)
Application.ScreenUpdating = False
MyQuery = "SELECT tDirection.DIR_NAME AS Direction, tPeriod.YEAR_ AS [Year], tPeriod.MTH_NUM AS [Month], tPeriod.PERIOD AS Period, tCountry.COUN_NAME AS Country, "
MyQuery = MyQuery + "qUnionTrafficAll.TAP_CODE AS [TAP Code], qTAP_DP_Status.DP_NAME AS [Discount Partner], IIf([tDiscountStatus].[ST_NAME] Is Null,'No Discount',"
MyQuery = MyQuery + "[tDiscountStatus].[ST_NAME]) AS Status, tTraffic_EDS.TRF_NAME AS Service, tPartner.PART_NAME AS Partner, qUnionTrafficAll.NUM_CED AS Traffic, "
MyQuery = MyQuery + "[qUnionTrafficAll].[S_GR_CH]*[qSDRRates_" & stCurrency & "].[SDR_RATE] AS [Gross Charge], "
MyQuery = MyQuery + "IIf([qDiscountTariffs_" & stCurrency & "].[IOT_DISC] Is Null,[Gross Charge],[qDiscountTariffs_" & stCurrency & "].[IOT_DISC]*[qUniontrafficAll].[NUM_CED]) AS [Net Charge], "
MyQuery = MyQuery + "[Net Charge]/[qUniontrafficAll].[NUM_CED] AS [Actual Rate], qDiscountTariffs_" & stCurrency & ".IOT_DISC "
MyQuery = MyQuery + "FROM (tCountry INNER JOIN tPartner ON tCountry.COUN_CODE = tPartner.COUNT_CODE) INNER JOIN (((tCallEventDetail INNER JOIN "
MyQuery = MyQuery + "(((tPeriod INNER JOIN (((qUnionTrafficAll LEFT JOIN qDiscountTariffs_" & stCurrency & " ON (qUnionTrafficAll.DIR_CODE = qDiscountTariffs_" & stCurrency & ".DIR_CODE) AND "
MyQuery = MyQuery + "(qUnionTrafficAll.YEAR_ = qDiscountTariffs_" & stCurrency & ".YEAR_) AND (qUnionTrafficAll.MTH_NUM = qDiscountTariffs_" & stCurrency & ".MTH_NUM) AND "
MyQuery = MyQuery + "(qUnionTrafficAll.CED_CODE = qDiscountTariffs_EUR.CED_CODE) AND (qUnionTrafficAll.SF1_CODE = qDiscountTariffs_" & stCurrency & ".SF1_CODE) AND "
MyQuery = MyQuery + "(qUnionTrafficAll.TAP_CODE = qDiscountTariffs_EUR.TAP_CODE)) LEFT JOIN qSDRRates_" & stCurrency & " ON (qUnionTrafficAll.YEAR_ = qSDRRates_" & stCurrency & ".YEAR_) AND "
MyQuery = MyQuery + "(qUnionTrafficAll.MTH_NUM = qSDRRates_EUR.MTH_NUM)) INNER JOIN tServiceFamily1 ON qUnionTrafficAll.SF1_CODE = tServiceFamily1.SF1_CODE) ON "
MyQuery = MyQuery + "(tPeriod.MTH_NUM = qUnionTrafficAll.MTH_NUM) AND (tPeriod.YEAR_ = qUnionTrafficAll.YEAR_)) INNER JOIN tDirection ON "
MyQuery = MyQuery + "qUnionTrafficAll.DIR_CODE = tDirection.DIR_CODE) INNER JOIN tTAP ON qUnionTrafficAll.TAP_CODE = tTAP.TAP_CODE) ON tCallEventDetail.CED_CODE = "
MyQuery = MyQuery + " qUnionTrafficAll.CED_CODE) LEFT JOIN qTAP_DP_Status ON (qUnionTrafficAll.TAP_CODE = qTAP_DP_Status.TAP_CODE) AND (qUnionTrafficAll.YEAR_ = qTAP_DP_Status.YEAR_) "
MyQuery = MyQuery + "AND (qUnionTrafficAll.MTH_NUM = qTAP_DP_Status.MTH_NUM)) INNER JOIN tTraffic_EDS ON (tServiceFamily1.SF1_CODE = tTraffic_EDS.SF1_CODE) "
MyQuery = MyQuery + "AND (tCallEventDetail.CED_CODE = tTraffic_EDS.CED_CODE)) ON tPartner.PART_CODE = tTAP.PART_CODE "
MyQuery = MyQuery + "WHERE (((tPeriod.PERIOD) Between #" & stPeriodFrom & "# And #" & stPeriodTo & "#) AND ((tCountry.COUN_NAME)='" & stCountry & "'))"
Set MyDatabase = DBEngine.OpenDatabase("\\palladium_zdm\data\NetStorage\Int_roam\Polishchuk\Roaming Partners Traffic Database\Roaming Statistic Database.mdb")
Set MyRecordset = MyDatabase.OpenRecordset(MyQuery)
Application.SheetsInNewWorkbook = 1
Set wrbReport = Workbooks.Add
With wrbReport
Set shtData = .Sheets(1)
shtData.Name = "Data"
ThisWorkbook.Sheets("Model").Copy before:=shtData
Set shtReport = .Sheets("Model")
shtReport.Name = "Report"
End With
With shtData
.Select
.UsedRange.ClearContents
.Range("A2").CopyFromRecordset MyRecordset ' ОШИБКА ВОЗНИКАЕТ В ЭТОМ МЕСТЕ
For i = 1 To MyRecordset.Fields.Count
.Cells(1, i).Value = MyRecordset.Fields(i - 1).Name
Next i
End With
With wrbReport
If stSaveAs <> "" Then
.SaveAs stSaveAs
If bOpenReport = False Then
.Close
End If
End If
End With
MsgBox "Your Query has been Run"
End Sub
http://www.sql.ru/forum/1106709/eksport-dannyh-v-excel-iz-access-vba-oshibka-pri-ispolnenii-koda
