VBScript - Excel 2007 - Reading DBF Files At Super Speed!
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
RsToExcel mySheet,rs
rs.Close
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
Sub RsToExcel(sheet,rs)
Dim fieldNames,i
rs.MoveFirst
Redim fieldNames(rs.Fields.Count - 1)
For i=0 To rs.Fields.Count -1
fieldNames(i)=rs.Fields(i).Name
Next
mySheet.Range(mySheet.Cells(1,1),mySheet.Cells(1,rs.Fields.Count)).Value=fieldNames
For i=1 To rs.Fields.Count
mySheet.Columns(i).AutoFit
Next
mySheet.Cells.CopyFromRecordSet rs
mySheet.Rows(1).Insert
mySheet.Range(mySheet.Cells(1,1),mySheet.Cells(1,rs.Fields.Count)).Value=fieldNames
End Sub
[Via]