Introduction
Here are two code snippets covering how to use ADODB to read and write Excel data into/out of DBF files:
I could have tried a lot harder to lay this out, but the day job is getting in the way :( Anyhow, if you're looking to read or write data from DBF files, or any other sort of database, this might be worth a read.
It would seem that Excel 2007 has dropped support for DBF files. Here is a very simple script to open DBF files in Excel 2007.
This is a first cut script. I have forced Excel to not do data conversion using the 'formula' trick. So, this is OK for viewing files, but needs more work to be perfect. I'll try and find some more time soon. To use the script, place it on your desktop. Then, drag the DBF file onto it and drop it on the script. The script will then open Excel and load the data from the DBF file into a new spreadsheet in a new workbook.
If you would like to learn more about drag-and-drop scripting, Scripting Macros, and generally become an Excel god, see my book "Baby Steps - how to become an Excel god without really trying". There is a link at the bottom of this page for more information.
Option Explicit
Dim inputFile,path,fileName,tableName
Dim rs,fieldVals,i,myExcel,myWorkBook,mySheet,row,column
Const adOpenDynamic=2
Const adLockPessimistic=2
Const adCmdTable=2
Const adOpenForwardOnly=0
inputFile=WScript.Arguments.Item(0)
path=Split(inputFile,"\")
fileName=path(Ubound(path))
path(Ubound(path))=""
path=Join(path,"\")
tableName=Left(fileName,Len(fileName)-4)
Dim dBConn
Set dBConn=OpenDBFConn(path)
Set rs=CreateObject("ADODB.Recordset")
rs.Open tableName, dbConn, adOpenForwardOnly, _
adLockPessimistic, adCmdTable
Set myExcel=CreateObject("Excel.Application")
Set myWorkBook=myExcel.Workbooks.Add()
Set mySheet=myWorkBook.Sheets(1)
myExcel.Visible=TRUE
rs.MoveFirst
Dim field
row=1
column=1
For Each field In rs.Fields
mySheet.Cells(row,column).Value=field.Name
WScript.Echo field.type
column=column+1
Next
row=2
Redim fieldVals(rs.Fields.Count - 1)
While Not rs.EOF
column=0
For Each field In rs.Fields
fieldVals(column)="=""" & _
field.Value & """"
column=column+1
Next
mySheet.Range(mySheet.Cells(row,1), _
mySheet.Cells(row,column)).Formula=fieldVals
row=row+1
rs.MoveNext
Wend
rs.Close
WScript.Echo "Loading Finished"
Function OpenDBFConn(Path)
Dim Conn
Set Conn = CreateObject("ADODB.Connection")
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Path & ";" & _
"Extended Properties=""DBASE IV;"";"
Set OpenDBFConn = Conn
End Function
Again, it would appear that Excel 2007 has dropped support for DBF format. Here is a simple script which converts Excel (.xls, .xlsx, .csv etc.) files to DBF format.
This is a very long way from being perfect. The worse thing about this implementation is that it only ever stores things as VARCHAR(64)
. I might have a go at making a slightly more type-friendly version soon.
This script uses the drag-and-drop scripting techniques as explained in my book 'Baby Steps - how to become an Excel god without really trying'. If you would like to know more about how to take over the world with Excel, check out the link to the book at the bottom of my blog pages ;)
The script will produce a xxxx_n.dbf file for each spreadsheet in your workbook, were xxxx is the name of the workbook file and n is the index of the spreadsheet (1, 2 etc.). The script works by using ADODB to create a DBF table with 'Create Table' and then opening a dynamic recordset to that table (creating a table with a DBF provider creates a DBF file). Then, AddNew
is called on the recordset for each non-blank row in the spreadsheet. I use array access to the spreadsheet to speed things up.
Option Explicit
Dim inputFile, path, fileName, tableName, createTable
inputFile=WScript.Arguments.Item(0)
path=Split(inputFile,"\")
fileName=path(Ubound(path))
path(Ubound(path))=""
path=Join(path,"\")
Dim dBConn
Set dBConn=OpenDBFConn(path)
tableName=Split(fileName,".")
tableName(Ubound(tableName))=""
tableName=Join(tableName,".")
tableName=Left(tableName,Len(tableName)-1)
Dim myExcel,myWorkbook, mySheet,nColumns,column
Dim fields,row,scan,thisTableName,sheetCount
Dim createString,i
Set myExcel=CreateObject("Excel.Application")
myExcel.Visible=TRUE
Set myWorkbook=myExcel.Workbooks.Open(inputFile)
sheetCount=1
For Each mySheet In myWorkbook.Sheets
scan=mySheet.Rows(1).Value
For nColumns=1 To UBound(scan,2)
If IsEmpty(scan(1,nColumns)) Then Exit For
Next
nColumns=nColumns-1
If nColumns >0 Then
thisTableName=tableName & "_" & sheetCount
createString="CREATE TABLE "
createString=createString & thisTableName & " ("
For i=1 to nColumns
createString = createString & "[" & _
Replace(scan(1,i)," ","_") & _
"] VARCHAR(64) "
If Not i=nColumns Then
createString=createString & ", "
Next
createString=createString & " )"
On Error Resume Next
dbConn.Execute "Drop Table " & thisTableName
On Error Goto 0
WScript.Echo createString
dBConn.Execute createString
Dim rs,fieldPos,fieldVals
Redim fieldPos(nColumns-1)
Redim fieldVals(nColumns-1)
For i=0 to nColumns-1
fieldPos(i)=i
Next
Set rs=CreateObject("ADODB.Recordset")
Const adOpenDynamic=2
Const adLockPessimistic=2
Const adCmdTable=2
rs.Open thisTableName, dbConn, adOpenDynamic, _
adLockPessimistic, adCmdTable
For row=2 to 1048576
scan=mySheet.Rows(row).Value
For i=1 to nColumns
If Not IsEmpty(scan(1,i)) Then Exit For
Next
If i > nColumns Then Exit For
For i=0 to nColumns-1
fieldVals(i)=scan(1,i+1)
Next
rs.AddNew fieldPos,fieldVals
Next
rs.Close
End If
sheetCount=sheetCount+1
Next
Function OpenDBFConn(Path)
Dim Conn
Set Conn = CreateObject("ADODB.Connection")
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Path & ";" & _
"Extended Properties=""DBASE IV;"";"
Set OpenDBFConn = Conn
End Function