Suggestions |
Example file
DBF file: read, analyse and write in Excel
|
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")
End SubIf VarType(c00) <> 11 Then snb_DBF_uitlezen c00 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)
End SubApplication.ScreenUpdating = False If Cells(13, 1) <>"" Then ThisWorkbook.A_schoon Open c09 For Binary As #1 c00 = Input(LOF(1), #1)
Close #1For j = 1 To 12 sp(j) = Asc(Mid(c00, j, 1))
NextWith ThisWorkbook.Sheets(1) y = RGB(sp(9), sp(10), 0) \ 32 - 1
End Withsn = .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
NextIf 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)
End IfIf 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)))
ElseIf j < y + 15 Or j = UBound(sn) Then
sn(y + 14, j - 8) = sr(3) 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)
End Ifsn(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)))
NextFor jj = 0 To UBound(sr) sn(j, jj + 1) = sr(jj)
Next.Cells(1, 1).Resize(UBound(sn), UBound(sn, 2)) = sn .Columns(5).Resize(, y).AutoFit |