автоматически запрашивать и преобразовывать таблицу доступа к БД в Excel, используя VBS - PullRequest
Новая
       16

автоматически запрашивать и преобразовывать таблицу доступа к БД в Excel, используя VBS

3 голосов
/ 19 февраля 2009

У меня есть база данных Access. Я хотел бы автоматически запрашивать таблицу Data_01 и экспортировать результаты в электронную таблицу Excel, используя ADO в VBScript на ежедневной основе. В настоящее время мои навыки в ADO отсутствуют.

  1. У меня есть столбец даты и времени, в котором я бы выбирал элементы вчера и сегодня. В запросе GUI критерии будут Between Date() And Date()-1
  2. У меня есть столбец PartNumber, в котором я хотел бы выбрать конкретный номер детали. В запросе GUI критерии будут Series 400
  3. Затем я хотел бы выбрать другие столбцы на основе критериев в пунктах 1. и 2.
  4. Я хотел бы также получить строку заголовка для столбцов.

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

Ответы [ 4 ]

1 голос
/ 19 февраля 2009

Вот пример VBScript 

Dim cn 
Dim rs

strFile = "C:\Docs\LTD.mdb"

strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile & ";"

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open strCon

strSQL = "SELECT * FROM tblTable " _
& "WHERE CrDate Between Now() And Date()-1 " _
& "AND OtherField='abc' " _
& "AND PartNumber=1 " _
& "ORDER BY CrDate, PartNumber"

rs.Open strSQL, cn

Set xl = CreateObject("Excel.Application")
Set xlBk = xl.Workbooks.Add

With xlbk.Worksheets(1)
    For i = 0 To rs.Fields.Count - 1
        .Cells(1, i + 1) = rs.Fields(i).Name
    Next

    .Cells(2, 1).CopyFromRecordset rs
    .Columns("B:B").NumberFormat = "m/d/yy h:mm"
End With

xl.Visible=True
1 голос
/ 19 февраля 2009

Вы пробовали встроенные в Excel функции для импорта данных? У меня нет версии Excel на английском языке, поэтому я не буду приводить вас к ним, но я думаю, что меню называется «Данные».

0 голосов
/ 20 февраля 2009

Если у вас нет Excel, вы можете получить доступ к xls с помощью ADO следующим образом 


Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H0001
Const strDB = "" 'Location of Database file
Const strXLS = "" 'Location of spreadsheet


Set objAccessConnection = CreateObject("ADODB.Connection")
objAccessConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & strDB
Set objExcelConnection = CreateObject("ADODB.Connection")
objExcelConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strXLS & ";Extended Properties=""Excel 8.0;HDR=Yes;"";"
Set objAccessRecordset = CreateObject("ADODB.Recordset")
Set objExcelRecordSet = CreateObject("ADODB.Recordset")

strAccessQuery = "SELECT * FROM Data_01 WHERE PartNumberColumn = 'Series 400' AND DateColumn BETWEEN #" & Date -1 & "# AND #" & Date & "#"
objAccessRecordset.Open strAccessQuery, objAccessConnection, adOpenStatic, adLockOptimistic

strTable = "Sheet1$"
objExcelRecordSet.Open "Select * FROM [" & strTable & "]", objExcelConnection, adOpenStatic, adLockOptimistic, adCmdText

Do Until objAccessRecordset.EOF
   objExcelRecordSet.AddNew
   For i = 0 To objAccessRecordSet.Fields.Count - 1
       objExcelRecordset.Fields(i).Value = objAccessRecordset.Fields(i).Value
   Next
   objExcelRecordSet.Update
   objAccessRecordset.MoveNext
Loop

objExcelRecordset.Close
Set objExcelRecordset = Nothing
objAccessRecordset.Close
Set objAccessRecordset = Nothing
objAccessConnection.Close
Set objAccessConnection = Nothing

Единственное, на что нужно обратить внимание, - это убедиться, что столбцы в электронной таблице имеют заголовок в первой строке, в противном случае этот скрипт может завершиться ошибкой.

EDIT:
Вы также можете записать набор записей в файл .csv. 


Const adClipString = 2
Const ForWriting = 2
Const ForAppending = 8
Const strDB = "C:\Test.mdb"
Const strCSV = "C:\Test.csv"


Set objAccessConnection = CreateObject("ADODB.Connection")
objAccessConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" & strDB

Set objAccessRecordset = CreateObject("ADODB.Recordset")

strAccessQuery = "SELECT * FROM Data_01 WHERE PartNumber = 'Series 400' AND TheDate BETWEEN #" & Date -1 & "# AND #" & Date & "#"
objAccessRecordset.Open strAccessQuery, objAccessConnection, adOpenStatic, adLockOptimistic

Set objCSV = CreateObject("Scripting.FileSystemObject").OpenTextFile(strCSV, ForAppending, True)
objCSV.Write objAccessRecordset.GetString(adClipString,,",",CRLF)

objCSV.Close
Set objCSV = Nothing
objAccessRecordset.Close
Set objAccessRecordset = Nothing
objAccessConnection.Close
Set objAccessConnection = Nothing

Excel откроет .csv файлы без проблем. Недостатком этого метода является то, что Excel плохо справляется с сохранением CSV-файлов, но в Excel CSV-файл может быть сохранен как xls.

0 голосов
/ 19 февраля 2009

Моя первая реакция заключается в следующем:

  1. Создайте объект запроса в MS Access, который найдет данные, которые вы хотите экспортировать [Окно базы данных -> Запросы -> Создать (пока используйте GUI Builder)]
  2. Создание макроса, который экспортирует запрос в файл Excel. Я говорю больше об этом здесь . Вы могли бы сделать это и в VBA ... многие сказали бы, что это более "чисто" (у меня также есть макросы); но все, что плывет на твоей лодке.
  3. Установите макрос autoexec (он будет запускаться автоматически при открытии MS Access), который запускает только что созданный макрос экспорта и затем выходит из MS Access (вы можете переопределить это, удерживая клавишу Shift во время загрузки Access). Было бы немного лучше также создать отдельный файл MS Access для предварительной обработки этих операций, не затрагивая исходный файл MS Access, просто создавая ссылки на таблицы в оригинале.
  4. Настройка запланированной задачи для открытия файла MS Access один раз в день.
...