MS Access макрос для экспорта в Excel предел 65к записей

Question

У меня есть макрос (созданный с помощью мастера макросов), который запускает несколько запросов, а затем выводит таблицу в excel. В таблице указано более 65 000 записей для экспорта форматированных таблиц. Как экспортировать таблицу без форматирования в макросе? Вот ошибка, которую я получаю после запуска макроса.

Answer 1

Я знаю, что вы используете VBA доступа для экспорта записей, но вы думали об использовании DataLink на запрос от первенствует и с помощью VBA доступа, чтобы открыть файл первенствовать и обновить таблицу данных? это, безусловно, устранит любые проблемы с максимальными строками и не должно иметь проблем с сбоем из-за размера экспорта. Если вам нужна дополнительная информация о том, как это сделать, дайте мне знать, и я добавлю дополнительную информацию здесь.

Answer 2

Вот код, запрошенный Энтони Григгсом выше. Но это решение VBA, а не макро-решение, поэтому оно прямо не реагирует на вопрос, как опубликовано. Именно так я работал над проблемой и успешно работал в производстве в течение длительного времени.

Перед использованием этого кода обязательно добавьте ссылку на «Microsoft ActiveX Data Objects 2.8 Library» (или текущую версию для вас), а также «Библиотека объектов Microsoft Excel 12.0» (или текущую версию). Сохранение изменений и завершение в конце имеют решающее значение, в противном случае он оставляет Excel открытым в фоновом режиме, который вы должны убить с помощью диспетчера задач.

Dim rs As New ADODB.Recordset 

    Dim xl As New Excel.Application 
    Dim xlWb As Excel.Workbook 
    Dim xlRange As Excel.Range 

    xl.Visible = False 
    xl.ScreenUpdating = False 

    vcurfilename = "MyFilename.XLSX” 

    Set xlWb = xl.Workbooks.Open(vcurfilename, 0, False, 5, "password", "password") 

    rs.Open "Select * from qryMyAccessQuery", CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly 
    Set xlRange = xlWb.Worksheets("MyExcelSheetName").Range("A1").Offset(1, 0) 
    xlWb.Sheets("MyExcelSheetName ").Range("a2:bq25000").ClearContents 
    xlRange.Cells.CopyFromRecordset rs 

    xl.Range("Table1").Sort key1:=xl.Range("Table1[[#All],[MyColumnName]]"), _ 
    order1:=xlAscending, Header:=xlYes 

    On Error Resume Next 
    xl.Range("table1").Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete 
    On Error GoTo 0 
    rs.Close 

    xl.Range("table1").ListObject.HeaderRowRange.Find("MyColumnName1").EntireColumn.NumberFormat = "dd-MMM-yy" 
    xl.Range("table1").ListObject.HeaderRowRange.Find("MyColumnName2").EntireColumn.NumberFormat = "dd-MMM-yy" 
    xl.Range("table1").ListObject.HeaderRowRange.Find("MyColumnName3").EntireColumn.NumberFormat = "dd-MMM-yy" 

    xlWb.Close SaveChanges:=True 
    xl.Quit 
    DoEvents