Экспорт результатов запроса кросс-таблицы в Excel из MS Access

Question

Я пытался с ограниченным успехом экспортировать результат запроса кросс-таблицы в Excel с помощью Access 2003. Иногда экспорт работает правильно, а Excel показывает без ошибок. В других случаях, используя одни и те же параметры запроса, я получаю ошибку 3190 - слишком много полей. Я использую параметр TransferSpreadsheet в макросе, который вызывается из кода VB.

Макрос имеет следующие параметры: Тип перевода: Экспорт Тип таблицы: Microsoft Excel 8-10 Имя таблицы: (это мое имя запроса) Имя файла: (выходной файл Excel, который существует в каталоге) Имена полей: Да

Запрос не должен содержать не более 14 столбцов информации, поэтому ограничение Excel 255 col не должно быть проблемой. Кроме того, данные в базе данных не меняются в течение времени, которое я запрашиваю, поэтому в одном и том же запросе будет создан тот же набор результатов.

Одним из единственных решений, которые я прочитал в сети до сих пор, является закрытие набора записей перед запуском макроса, но это удар или промах.

Ваши мысли/помощь с благодарностью!

Answer 1

У меня есть работающий как MS Access Macro. Он использует OutputTo действий с:

• Тип объекта = Запрос
• Имя объекта = [WhateverQueryName]
• Output Format = MicrosoftExcel (* XLS.)
• Auto Start = Нет
• (все остальное пустое)

Ненавижу использовать макросы в MS Access (он чувствует себя нечистым), но, возможно, попробуйте.

Answer 2

Обходным решением было бы сначала добавить запрос в таблицу, а затем экспортировать его.

DoCmd.SetWarnings False 
DoCmd.OpenQuery "TempTable-Make" 
DoCmd.RunSQL "DROP TABLE TempTable" 
ExportToExcel() 
DoCmd.SetWarnings True 

TempTable-Make - это запрос на основе таблицы, основанный на кросс-таблице.

Here - соответствующая функция ExportToExcel, которую вы можете использовать.

Answer 3

Если вы готовы использовать небольшую vba, а не придерживаться исключительно макросов, следующее может вам помочь. Этот модуль принимает любой sql, который вы выбрасываете, и экспортирует его в определенное место на листе excel. После того, как модуль является двумя примерами его использования, можно создать совершенно новую книгу, которая открывает существующую. Если вы не уверены в использовании SQL, просто создайте требуемый запрос, сохраните его и затем поставьте «SELECT * FROM [YourQueryName]» в Sub как параметр QueryString.

Sub OutputQuery(ws As excel.Worksheet, CellRef As String, QueryString As String, Optional Transpose As Boolean = False) 

    Dim q As New ADODB.Recordset 
    Dim i, j As Integer 

    i = 1 

    q.Open QueryString, CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly 


    If Transpose Then 
     For j = 0 To q.Fields.Count - 1 
      ws.Range(CellRef).Offset(j, 0).Value = q(j).Name 
      If InStr(1, q(j).Name, "Date") > 0 Or InStr(1, q(j).Name, "DOB") > 0 Then 
       ws.Range(CellRef).Offset(j, 0).EntireRow.NumberFormat = "dd/mm/yyyy" 
      End If 
     Next 

     Do Until q.EOF 
      For j = 0 To q.Fields.Count - 1 
       ws.Range(CellRef).Offset(j, i).Value = q(j) 
      Next 
      i = i + 1 
      q.MoveNext 
     Loop 
    Else 
     For j = 0 To q.Fields.Count - 1 
      ws.Range(CellRef).Offset(0, j).Value = q(j).Name 
      If InStr(1, q(j).Name, "Date") > 0 Or InStr(1, q(j).Name, "DOB") > 0 Then 
       ws.Range(CellRef).Offset(0, j).EntireColumn.NumberFormat = "dd/mm/yyyy" 
      End If 
     Next 

     Do Until q.EOF 
      For j = 0 To q.Fields.Count - 1 
       ws.Range(CellRef).Offset(i, j).Value = q(j) 
      Next 
      i = i + 1 
      q.MoveNext 
     Loop 
    End If 

    q.Close 

End Sub 

Пример 1:

Sub Example1() 
    Dim ex As excel.Application 
    Dim wb As excel.Workbook 
    Dim ws As excel.Worksheet 

    'Create workbook 
    Set ex = CreateObject("Excel.Application") 
    ex.Visible = True 
    Set wb = ex.Workbooks.Add 
    Set ws = wb.Sheets(1) 

    OutputQuery ws, "A1", "Select * From [TestQuery]" 
End Sub 

Пример 2:

Sub Example2() 
    Dim ex As excel.Application 
    Dim wb As excel.Workbook 
    Dim ws As excel.Worksheet 

    'Create workbook 
    Set ex = CreateObject("Excel.Application") 
    ex.Visible = True 
    Set wb = ex.Workbooks.Open("H:\Book1.xls") 
    Set ws = wb.Sheets("DataSheet") 

    OutputQuery ws, "E11", "Select * From [TestQuery]" 
End Sub 

Надеется, что это какое-то полезным для вас.