Как я могу экспортировать выбранные данные в Excel из Access?

Question

Я использую код из Функция для экспорта запроса или таблицы в MS Excel для экспорта всех данных из одной таблицы Access в рабочую таблицу в MS Excel.

Эта программа хранит время и время сотрудников в таблице.

Допустим, администратор хочет отфильтровать данные с 19 января по 15 января. Я хочу разместить два средства выбора датыв моей форме в качестве основы для «От» и «До».

Я хочу экспортировать выбранные данные.Как я могу ввести это в этот код?

Public Function Export2XL(InitRow As Long, DBAccess As String, DBTable As String) As Long

Dim cn As New ADODB.Connection        'Use for the connection string
Dim cmd As New ADODB.Command          'Use for the command for the DB
Dim rs2 As New ADODB.Recordset        'Recordset return from the DB
Dim MyIndex As Integer                'Used for Index
Dim MyRecordCount As Long             'Store the number of record on the table
Dim MyFieldCount As Integer           'Store the number of fields or column
Dim ApExcel As Object                 'To open Excel
Dim MyCol As String
Dim Response As Integer

Set ApExcel = CreateObject("Excel.application")  'Creates an object

ApExcel.Visible = True                           'This enable you to see the process in Excel
pExcel.Workbooks.Add                             'Adds a new book.
ApExcel.ActiveSheet.Name = "" & (Export_data.Label1.Caption) & ""

'Set the connection string
cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;data source=" & 
app.Path & "\Dbase.mdb; User ID=admin;Persist Security Info=False;JET 
OLEDB:Database Password=akgtrxx21"
'Open the connection
cn.Open

'Check that the connection is open
If cn.State = 0 Then cn.Open
Set cmd.ActiveConnection = cn
cmd.CommandText = DBTable
cmd.CommandType = adCmdTable
Set rs2 = cmd.Execute
'Count the number of fields or column
MyFieldCount = rs2.Fields.count

'Fill the first line with the name of the fields
For MyIndex = 0 To MyFieldCount - 1
    ApExcel.Cells(InitRow, (MyIndex + 1)).Formula = rs2.Fields(MyIndex).Name   
    'Write Title to a Cell
    ApExcel.Cells(InitRow, (MyIndex + 1)).Font.Bold = True
    ApExcel.Cells(InitRow, (MyIndex + 1)).Interior.ColorIndex = 36
    ApExcel.Cells(InitRow, (MyIndex + 1)).WrapText = True
Next

'Draw border on the title line
MyCol = Chr((64 + MyIndex)) & InitRow
ApExcel.Range("A" & InitRow & ":" & MyCol).Borders.Color = RGB(0, 0, 0)
MyRecordCount = 1 + InitRow

'Fill the excel book with the values from the database
Do While rs2.EOF = False
    For MyIndex = 1 To MyFieldCount
        ApExcel.Cells(MyRecordCount, MyIndex).Formula = rs2((MyIndex - 1)).Value     
        'Write Value to a Cell
        ApExcel.Cells(MyRecordCount, MyIndex).WrapText = False 'Format the Cell
    Next
    MyRecordCount = MyRecordCount + 1
    rs2.MoveNext
    If MyRecordCount > 50 Then
        Exit Do
    End If
Loop

'Close the connection with the DB
rs2.Close

'Return the last position in the workbook
Export2XL = MyRecordCount
Set cn = Nothing
Set cmd = Nothing
Set rs2 = Nothing

Set ApExcel = Nothing

End Function

Answer 1

В Excel есть способ импортировать данные из Access без VBA вообще.

1. Создайте соединение для заполнения вашей рабочей таблицы . Перейдите в меню «Данные»> «Доступ». Вам будет предложено выбрать базу данных Access и выбрать таблицу, которую вы хотите. Возможно, вы хотите, чтобы запрос был выполнен, но сейчас выберите любую таблицу; это будет отредактировано позже.

2. Измените запрос на то, что вы хотите .
   Откройте окно подключения, щелкнув меню Data> Connections и выберите только что созданное подключение. Затем перейдите на следующую вкладку (Определение), измените Тип команды с Таблицы на SQL, затем в тексте команды введите свою команду.
   Пока не закрывайте окно.

3. Добавить условие на вашу дату .
   Если поле вызывается, например, MyDate, то добавьте предложение WHERE, подобное следующему: (MyDate >= ? AND MyDate <= ?).
   Когда вы обновите данные, вам будет предложено указать значения, заменяющие 2 знака вопроса, и у вас будет возможность назначить ячейку для этого. У вас также будет возможность для запроса всегда использовать то, что вы определили.

Обратите внимание, что если все сделано правильно, вы можете изменить порядок полей и / или создать формулы в таблице, не создавая никаких проблем для Excel. Вы также можете создать строку Итого внизу, чтобы суммировать значения, используя формулу (Excel покажет вам выпадающий список для создания формулы SUBTOTAL, которая удобно чувствительна к фильтрам.

Если вы хотите обновить данные с помощью VBA, потребуется всего одна строка кода: ThisWorkbook.Connections(...).Refresh или ApExcel.Workbooks(..).Connections(...).Refresh.

PS: Если вы абсолютно хотите сохранить свой код выше, то, по крайней мере, убедитесь, что вы не копируете rs2 ячейка за ячейкой (что очень медленно из-за обработки событий в Excel), а скорее делаете что-то вроде: ApExcel.Cells(2, 1).CopyFromRecordset rs2