Written by Recently, I had the need of printing the data structures of many dbf files. A google search reveled the DBF.COM file that would output dbf file structures, number of records, file name, date of last update, etc.
Download this file here: files/DBF.COM (Caution: I downloaded this file from the internet, and I do not make any warranty of it being spyware or malicious ware free. Use it on your own risk.)
To use this file go to Start>Run>cmd and in DOS type:
dbf.com > myfilestru.txt
Note: cd is used to change the current directory
Here’s a print screen:
This will create a file myfilestru.txt in the same directory where your dbf files are residing. This text file will look like this:
Now, that we have a text file all the file structures, we need to create separate workbooks for each dbf file. To do that open this text file in Excel, press Alt + F11 to view the VBA window, double-click the sheet name, and paste this code. After that run this code, and you should have separate workbooks for each dbf file.
‘Define some variables
Dim iLastRow As Integer, i As Integer, sWrkbkNm As String, sNewWrkbkNm As String
Dim iPrevLastRow As Integer, iFirstRow As Integer, iNewWrkbkRow As Integer
On Error GoTo FormatThisFile_Error
‘Turn off the screen update to run the macro faster
Application.ScreenUpdating = False
‘Refer to the current workbook and sheet1
With ThisWorkbook.Sheets(1)
‘get the last row number
iLastRow = .Range(“A65536″).End(xlUp).Row
i = 1
Do While i < iLastRow
‘search for string “Structure for”
If InStr(1, .Range(“A” & i), “Structure for”) > 0 Then
‘if found then store the file name
sWrkbkNm = Trim(Right(.Range(“A” & i), Len(.Range(“A” & i)) – Application.WorksheetFunction.Find(“:”, .Range(“A” & i))))
sWrkbkNm = Left(sWrkbkNm, Len(sWrkbkNm) – 4)
iFirstRow = i
‘search for string “** Total **”
ElseIf InStr(1, .Range(“A” & i), “** Total **”) > 0 Then
iPrevLastRow = i
‘add a workbook
Workbooks.Add
‘save it
ActiveWorkbook.SaveAs ThisWorkbook.Path & “\” & sWrkbkNm
sNewWrkbkNm = sWrkbkNm & “.xls”
‘with this new workbook do copy-paste
With Workbooks(sNewWrkbkNm)
ThisWorkbook.Sheets(1).Range(“A” & iFirstRow & “:” & “A” & iPrevLastRow).Copy Destination:= _
.Sheets(1).Range(“A1″)
iNewWrkbkRow = .Sheets(1).Range(“A65536″).End(xlUp).Row
.Sheets(1).Range(“A4:A” & iNewWrkbkRow).TextToColumns Destination:= _
.Sheets(1).Range(“A4″), DataType:=xlDelimited, Space:=True
.Sheets(1).Range(“A5:A” & iNewWrkbkRow – 1).Delete Shift:=xlToLeft
.Sheets(1).Columns(“A:IV”).EntireColumn.AutoFit
.Sheets(1).Columns(“A:IV”).WrapText = False
‘save and close this workbook
.Save
.Close
End With
End If
i = i + 1
Loop
MsgBox “Done”
End With
On Error GoTo 0
SmoothExit_FormatThisFile:
Application.ScreenUpdating = True
Exit Sub
FormatThisFile_Error:
MsgBox “Er
ror ” & Err.Number & ” (” & Err.Description & “) in procedure FormatThisFile”
Resume SmoothExit_FormatThisFile
End Sub
Related posts:
Recent Comments