Click here to Skip to main content
13,555,131 members
Click here to Skip to main content
Add your own
alternative version


11 bookmarked
Posted 21 Aug 2007

Repair DBF File corrupted by power failer

, 21 Aug 2007
Rate this:
Please Sign up or sign in to vote.
Repair the DBF file which corrupted by any cause.
Screenshot - Screen2.jpg


Repair DBF files corrupted by any cause, like Power failer, or abnormally PC shutdown


Usually when power fails and that time the DBF file is in use, the DBF file corrupts and when you try to open the file, It give the message Not a Database file.

Using the code

Before you start add OpenFileDialog component and Activex Data Component References to your project. and assign below Local variables at Form Level.

Dim byteArray As Variant
Dim dblNoOfRecords As Double
Dim dblHeaderLength As Double
Dim dblRecordLength As Double
Dim dblActualRecords As Double

In OpenDialog Open Click event write below code. The code will first check whether the DBF file is corrupted Or Not. If it is corrupted then Repair DBF Button will set to True. Otherwise "No Error in Database" message displays on screen.

Private Sub cmdOpen_Click()
  DialogBox.DialogTitle = "Select DBF File"
  DialogBox.Filter = "DBF Files|*.dbf"
  DialogBox.DefaultExt = "dbf"
  If Trim(DialogBox.FileName) <> "" Then
    txtFileName.Text = DialogBox.FileName
    Dim objStream As New ADODB.Stream

    objStream.Type = adTypeBinary

    objStream.LoadFromFile Trim(DialogBox.FileName)
    byteArray = objStream.Read()

    dblNoOfRecords = byteArray(4) + byteArray(5) * 256 + byteArray(6) * 256 ^ 2 + byteArray(7) * 256 ^ 3
    dblHeaderLength = byteArray(8) + byteArray(9) * 256
    dblRecordLength = byteArray(10) + byteArray(11) * 256

    dblActualRecords = Int((objStream.Size - dblHeaderLength) / dblRecordLength)

    If dblNoOfRecords > dblActualRecords Then
      cmdRepair.Visible = True
      Label2.Caption = "Error Found... Click on Repair Database"
      'cmdRepair.Enabled = False
      'cmdRepair.Caption = "No Error in Database"
      Label2.Caption = "No Error in Database"
    End If
    Set objStream = Nothing
  End If
'  MsgBox "Error Description : " & Err.Description & Chr(13) & _
'         "Error Number : " & Err.Number
End Sub

Copy below code in Repair Click Event.

Private Sub cmdRepair_Click()
  Dim objStream As New ADODB.Stream
  objStream.Type = adTypeBinary
  byteArray(4) = dblActualRecords Mod 256
  byteArray(5) = Int(dblActualRecords / 256) Mod 256
  byteArray(6) = Int(dblActualRecords / 256 ^ 2) Mod 256
  byteArray(7) = Int(dblActualRecords / 256 ^ 3) Mod 256

  objStream.Write byteArray
  objStream.SaveToFile Trim(DialogBox.FileName), adSaveCreateOverWrite
  cmdRepair.Visible = False
  Set objStream = Nothing
  Label2.Caption = "Repair Succesfully Completed"
End Sub


Very usefull Utility to recover your Data at any moment.

About Bhaskar Shetty

BCA (Bachelor of computer application) more than 8+ years exprience in Software Development / Analyst / Implementation


This article has no explicit license attached to it but may contain usage terms in the article text or the download files themselves. If in doubt please contact the author via the discussion board below.

A list of licenses authors might use can be found here


About the Author

Bhaskar Shetty
Web Developer
India India
No Biography provided

You may also be interested in...


Comments and Discussions

GeneralMissing information Pin
Joergen Sigvardsson21-Aug-07 4:34
memberJoergen Sigvardsson21-Aug-07 4:34 
GeneralRe: Missing information Pin
Bhaskar Shetty21-Aug-07 4:59
memberBhaskar Shetty21-Aug-07 4:59 

General General    News News    Suggestion Suggestion    Question Question    Bug Bug    Answer Answer    Joke Joke    Praise Praise    Rant Rant    Admin Admin   

Use Ctrl+Left/Right to switch messages, Ctrl+Up/Down to switch threads, Ctrl+Shift+Left/Right to switch pages.

Permalink | Advertise | Privacy | Terms of Use | Mobile
Web01 | 2.8.180515.1 | Last Updated 21 Aug 2007
Article Copyright 2007 by Bhaskar Shetty
Everything else Copyright © CodeProject, 1999-2018
Layout: fixed | fluid