DBF file
Example file
DBF file: read, analyse and write in Excel

Read DBF files

A DBF file is a binary file with a very strict composition.
The rules concerning the structure of a DBF file have been changed several times.
In this example we concentrate on DBF version 5.

Description of the example file

The first 32 records of a DBF file contain general information on the contents of the file.
The next records contain the properties of every field in every record.
At last it contains the content of every record.

If you use the button 'Read DBF' you can select a DBF file.
Private Sub knop_inlezen_Click()
c00 = Application.GetOpenFilename("Files (*.dbf),*.dbf")
If VarType(c00) <> 11 Then snb_DBF_uitlezen c00
End Sub

The result of the code is a very detailed description of the DBF-file and presents the file's content in a userfriendly way. With this code we use Excel as a HEX-reader.
The code that reads the DBF file and writes the converted information into the Excel worksheet:

' number of fields
' size of the datamatrix



' 12 fixed data



' starting position of a field / record
' information on a field



' endrecords header and file

' recordinformation
Sub snb_DBF_uitlezen(c09)
Dim sp(35)
Application.ScreenUpdating = False

If Cells(13, 1) <>"" Then ThisWorkbook.A_schoon

Open c09 For Binary As #1
c00 = Input(LOF(1), #1)
Close #1

For j = 1 To 12
sp(j) = Asc(Mid(c00, j, 1))
Next

With ThisWorkbook.Sheets(1)
y = RGB(sp(9), sp(10), 0) \ 32 - 1
sn = .Cells(1, 1).Resize(15 + y + RGB(sp(5), sp(6), sp(7)) + sp(8) * 256 ^ 3, y + 4)
sn(4, 6) = c09

For j = 1 To UBound(sn)
If j < 13 Then
If sp(sn(j, 3)) >0 Then sn(j, 4) = Choose(sn(j, 2), sp(sn(j, 3)), RGB(sp(sn(j, 3)), sp(sn(j, 3) + 1), 0), DateSerial(sp(sn(j, 3)) + 2000, sp(sn(j, 3) + 1), sp(sn(j, 3) + 2)), RGB(sp(sn(j, 3)), sp(sn(j, 3) + 1), sp(sn(j, 3) + 2)) + sp(sn(j, 3) + 3) * 256 ^ 3)
Else
x = sn(j - 1, 3) + sn(j - 1, 2)
If j < y + 13 Then
sr = Array("Field " & j - 12, 32, x, Replace(Mid(c00, x, 10), Chr(0), ""), Mid(c00, x + 11, 1), Asc(Mid(c00, x + 16, 1)), Asc(Mid(c00, x + 17, 1)), IIf(j = 13, 1, sn(j - 1, 8) + sn(j - 1, 6)))
sn(y + 14, j - 8) = sr(3)
ElseIf j < y + 15 Or j = UBound(sn) Then
sr = Array(IIf(j = y + 14, sn(12, 1), IIf(j = UBound(sn), "EOF", "EOR")), 1, x, IIf(j = y + 14, "", "Chr(" & Asc(Mid(c00, x, 1)) & ")"))
Else
sr = Array("Record " & j - UBound(sn) + sn(3, 4) + 1, sn(5, 4), x)
sn(j, 4) = Trim(Mid(c00, x, 1))
For jj = 1 To y
sn(j, jj + 4) = Trim(Mid(c00, x + sn(jj + 12, 8), sn(jj + 12, 6)))
Next
End If

For jj = 0 To UBound(sr)
sn(j, jj + 1) = sr(jj)
Next
End If
Next

.Cells(1, 1).Resize(UBound(sn), UBound(sn, 2)) = sn
.Columns(5).Resize(, y).AutoFit
End With
End Sub