Re: A VB 6 program to read from and save to text file

Dear Mr. Leng,

I wrote a small program which for you, which imports the data from your text file into a database and displays them in a DBGrid. There, you can edit/add items and save them to a text file.

For safety purposes, the data are first written into a temporary file and then renamed, so you should never end up with a damaged data file.

Please note, that I use VB5, which lacks the Replace function. Therefore I wrote a small replacement. If you use VB6 you can change your code (although my replacement will also work on VB6).

But now to the code:

Create a project and add these controls:
DBGrid (grdData)
DataControl (Data1)
2 Command buttons (cmdRead, cmdSave)

Then, copy the following code into the form:

Option Explicit

'Some constants for easier customizing to your needs
Const DataFile As String = "Datafile.txt"
Const OldFile As String = "Datafile.txt.old"
Const NewFile As String = "Datafile.txt.new"
Const DBName As String = "data.mdb"
Const TableName As String = "MyData"

' This function reads the data from your file and inserts them into the
' database. Please note that based on your sample, the field length in
' the database is only 8 characters long. If you need a larger field,
' please change it accordingly.

Private Sub cmdRead_Click()
Dim Fh As Integer
Dim MyData As String
Dim PositionSpace As Integer
Dim Item As String, Price As String

CreateDB

'Open the database with the Data control
Data1.Connect = "Access"
Data1.DatabaseName = App.Path & "\" & DBName
Data1.Refresh

'Delete all old entries from the database
Data1.Database.Execute "DELETE * FROM " & TableName

'Get a file handle and open the data file for import
'into the database
Fh = FreeFile()
Open App.Path & "\" & DataFile For Input As Fh


'Read in the data and write them into the database
While Not EOF(Fh)
Line Input #Fh, MyData
PositionSpace = InStr(MyData, " ")
If PositionSpace > 0 Then
Item = Left(MyData, PositionSpace - 1)
Price = Right(MyData, Len(MyData) - PositionSpace)
Data1.Database.Execute "INSERT INTO " & TableName & " (ItemNo, ItemPrice) VALUES ('" & Item & "', " & Price & ")"
End If
Wend

'Close the data file
Close Fh

'Make the Data control read the imported data (for displaying them in
'the DBGrid.
Data1.RecordSource = "MyData"
Data1.Refresh
End Sub


'Save all data from the database into a temporary text file.
Private Sub cmdSave_Click()
Dim Fh As Integer
Dim MyData As String
Dim rs As Recordset

Set rs = Data1.Recordset

'Get a file handle and open the file for writing.
Fh = FreeFile()
Open App.Path & "\" & NewFile For Output As Fh

'Write all data into the temporary data file.
If rs.RecordCount > 0 Then
rs.MoveFirst
While Not rs.EOF
Print #Fh, rs!ItemNo & " " & Repl(rs!ItemPrice)

'If you use VB6, you can use this line instead (if you like):
' Print #Fh, rs!ItemNo &" " & Replace(rs!ItemPrice,",",".")

rs.MoveNext
Wend
End If

'Close the file
Close Fh

If ReplaceFile = False Then
MsgBox "An error occurred while trying to rename the temporary file.", vbCritical, "Error!"
End
End If
End Sub

'This function is for VB5 only
'In VB6 you can replace this by using
'Replace(rs!ItemPrice,",",".") instead

Private Function Repl(ByVal Value As Currency) As String
Dim retVal As String
Dim PosiComma As Integer

'Convert the currency value into string
retVal = Format(Value, "0.00")

'Check if there is a comma in the string.
'Important, if you use a comma instead of the
'point (e.g. in Germany)
PosiComma = InStr(retVal, ",")

'If there is a comma, replace it with a point.
If PosiComma > 0 Then
Mid(retVal, PosiComma, 1) = "."
End If

Repl = retVal
End Function


'This function tries to rename the temporary file.
Private Function ReplaceFile() As Boolean
Dim retVal As Boolean
Dim MyPath As String

retVal = False

'Trap errors that might occur
On Error GoTo Fehler

'Get the path and add a backslash
MyPath = App.Path & "\"

'Check if an old data file exists and try to delete it.
If Dir(MyPath & OldFile) > "" Then
Kill MyPath & OldFile
End If

'Rename the current data file to OlfFile.
Name MyPath & DataFile As MyPath & OldFile

'Rename the new file to be the current data file.
Name MyPath & NewFile As MyPath & DataFile

'Kill the old data file.
Kill MyPath & OldFile

'Everything was successful, so set the return variable to TRUE
retVal = True
GoTo EndeFunction

Fehler:
'Just continue as the return variable is FALSE already.
Resume EndeFunction

EndeFunction:
On Error GoTo 0
ReplaceFile = retVal
End Function

'This function creates the Access database, the table and
'the fields. If your item number should be larger than 8
'characters, you have to change it here.
Private Sub CreateDB()
Dim WS As Workspace
Dim db As Database
Set WS = DBEngine.Workspaces(0)
If Dir(App.Path & "\" & DBName) = "" Then
Dim TD As New TableDef
Dim FldItemNo As New Field
Dim FldItemPrice As New Field
Set db = WS.CreateDatabase(App.Path & "\" & DBName, dbLangGeneral, dbEncrypt)

TD.Name = TableName
FldItemNo.Name = "ItemNo"
FldItemNo.Type = dbText
FldItemNo.Size = 8
FldItemNo.AllowZeroLength = False

FldItemPrice.Name = "ItemPrice"
FldItemPrice.Type = dbCurrency

TD.Fields.Append FldItemNo
TD.Fields.Append FldItemPrice
db.TableDefs.Append TD
db.Close
End If
End Sub



Best Regards,

HKSHK
.

Loading