DBF bestand uitlezen voorbeeldbestand

DBF-bestanden uitlezen

Het kan soms handig zijn inzicht te krijgen in de inhoud van een DBF-bestand.
Een DBF-bestand is een binair bestand met een strikt voorgeschreven opbouw.
De voorschriften voor de struktuur van een DBF-bestand zijn in de loop van de tijd diverse keren gewijzigd.
Het voorbeeldbestand gaat uit van DBF versie 5.

Beschrijving van het voorbeeldbestand

De eerste 32 records van een DBF-bestand bevatten gegevens over de verdere inhoud van het bestand.
De volgende bevatten de eigenschappen van de velden van ieder record.
Tenslotte komt de inhoud van alle afzonderlijke records aan bod.

Met de knop DBF-inlezen kan een bestand geselecteerd worden.

Private Sub knop_inlezen_Click()
c00 = Application.GetOpenFilename("Files (*.dbf),*.dbf")
If VarType(c00) <> 11 Then snb_DBF_uitlezen c00
End Sub

De code die het bestand uitleest en de gegevens in het Excel werkblad zet:
















'   aantal velden
'   omvang gegevensmatrix



'   12 vaste gegevens



'   beginpositie van veld / record
'   veldinformatie



'   sluitrecords header en file

'   recordinformatie
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