Automatically query and convert db access table to excel using vbs

Question

I have an Access database. I would like to automatically query a table Data_01and export the results to an Excel spreadsheet using ADO in VBScript on a daily basis. I am currently lacking in ADO skills.

• I have a date column that I would pick from yesterday and today. In a GUI request, the criteria will beBetween Date() And Date()-1
• I have a column PartNumberthat I would like to select a specific part number. In a GUI request, the criteria will beSeries 400
• Then I would like to select other columns based on the criteria in paragraphs 1. and 2.
• I would also like to get a header row for the columns.

I am currently exporting the entire table to Excel, and then using VBScript I select the columns that I need, then delete all the unnecessary data, and then automatically set the columns for my final output file. This is apparently somewhat processor and temporary.

Answer 1

Have you tried the built-in functions in Excel to import data? I don’t have an English version of Excel, so I won’t direct you to them, but I think the menu is called Data.

Answer 2

Here is an example of 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

Answer 3

:

• MS Access, , . [ → → ( )]
• , Excel. . VBA... , "" ( ); , .
• autoexec ( MS Access), , MS Access ( , shift Access). MS Access , MS Access, .
• , MS Access .

Answer 4

If you don’t have Excel, you can access xls with ADO like this,

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

The only thing you need to pay attention to is to make sure that the columns in the spreadsheet have a heading in the first row, otherwise this script may fail.

EDIT:
You can also write a set of records to a CSV file.

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 will open .csv files without problems. The disadvantage of this method is that Excel cannot handle saving .csv files, but in excel the csv file can be saved as xls.