Print Structures of dbf files in separate workbooks

Home > Uncategorized > Print Structures of dbf files in separate workbooks

July 24th, 2007 Leave a comment Go to comments

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:

cd C:/

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.

Sub FormatThisFile()
‘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