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

excel ms-access export

10797 просмотра

4 ответа

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

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

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

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

Ваши мысли / помощь очень ценятся!

Источник Размещён: 18.07.2019 11:51

Ответы (4)


2 плюса

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

  • Тип объекта = Запрос
  • Имя объекта = [WhwhatQueryName]
  • Формат вывода = MicrosoftExcel (*. Xls)
  • Автозапуск = Нет
  • (все остальное пусто)

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

Автор: BIBD Размещён: 08.12.2008 03:25

1 плюс

Если вы готовы использовать небольшой 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

Надеюсь, это вам пригодится.

Автор: mavnn Размещён: 06.03.2009 01:32

0 плюса

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

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

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

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

Автор: Jon Wilson Размещён: 10.12.2008 03:35

0 плюса

Следующий код экспортирует запросы с использованием функции в Excel, которая была специально разработана для импорта наборов записей CopyFromRecordset. Обратите внимание, что имена полей должны быть добавлены, так как эта функция захватывает только фактические данные. Этот код работает даже на кросс-таблицы запросов.

'---------------------------------------------------------------------------------------
' Method : MoveQueryToWorksheet
' Author : ROLU
' Date   : 09.05.2018
' Purpose: Moves queries to specific worksheet in an Excel Workbook
'---------------------------------------------------------------------------------------
Function MoveQueryToWorksheet(wkb As Excel.Workbook, wks As Variant, strSQL As Variant) As Boolean
On Error GoTo MoveQueryToWorksheet_Error

'Dim rs As New ADODB.Recordset
'rs.Open strSQL, CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly

Dim dbs As DAO.Database
Set dbs = CurrentDb
Dim rs
Set rs = dbs.OpenRecordset(strSQL)

Dim lCol As Long
For lCol = 0 To rs.Fields.Count - 1
    wkb.Worksheets(wks).Cells(1, lCol + 1).Value = rs.Fields(lCol).Name
Next lCol
wkb.Worksheets(wks).Range("A2").CopyFromRecordset rs

'Close out and clean
Set rs = Nothing
MoveQueryToWorksheet = True

    Exit Function

MoveQueryToWorksheet_Error:
On Error GoTo 0
Set rs = Nothing
MoveQueryToWorksheet = False

End Function
Автор: rohrl77 Размещён: 18.07.2019 08:50
Вопросы из категории :
32x32