by Matt Hawrysko (2 Submissions)
Category: Databases/Data Access/DAO/ADO
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Tue 13th March 2001
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Written to access a dbf file and generate a flat ASCII text file, calculate employee hours and eventually write the data directly to a
VBcoders
' one named EMP.DBF and one named Totals, with the corresponding databases to be EMP.dbf
' and Totals.dbf
' Written to access a dbf file and generate a flat ASCII text file, calculate employee
' hours and eventually write the data directly to a mainframe system.
' Since this is a flat file, the field strEmpname is declared as a fixed 40 character
' string to fill the database on the mainframe and allows Lent1(Labor Entry) to write
' to the correct position in the database.
' To handle the decimal point in the field Total_1 and Total_2, I added a routine to
' parse out the decimal and rebuild the string.
' This program runs without a window until the final message box pops up to tell
' you the files are created.
' It's a little messy now, but you can change the names and clean up the extras to suit
' your needs.
' Matt Hawrysko << [email protected] >>
Private Sub Form_Load()
Dim nameRS As New ADODB.Recordset
Dim strEmpname As String * 40
Dim strEmpNum
Dim strLent
Dim NameNum()
ReDim NameNum(0)
' Open database
Const myConn = "DSN=EMP.DBF;" ' ODBC Driver name you must set up on your machine
Set nameRS = New ADODB.Recordset
nameRS.ActiveConnection = myConn
nameRS.Open _
("SELECT * FROM EMP ORDER BY EMPNUM")
'Now declare a file object and create the text file to write to
Dim fso As New FileSystemObject, txtfile
Set txtfile = fso.CreateTextFile("C:\EMP.DATA", True)
If nameRS.BOF And nameRS.EOF Then
MsgBox "Recordset is empty", 16, "Empty Record"
Else
Do Until nameRS.EOF
' Loop through the recordsets, build the array, then write it to a file.
strEmpname = nameRS!EMPNAME
strEmpNum = nameRS!EMPNUM
strLent = nameRS!LENT1
strEmpNum = Format(strEmpNum, "000000")
strEmpname = Format(strEmpname, ">")
NameNum(i) = strEmpNum & strEmpname & strLent
txtfile.Write NameNum(i)
txtfile.WriteLine
ReDim Preserve NameNum(UBound(NameNum) + 1)
nameRS.MoveNext
i = i + 1
Loop
txtfile.Close
' MsgBox "EMP.DATA has been created on your C drive"
nameRS.Close
End If
' ***********************************************************
' ***********************************************************
' Now open Totals.dbf for data manipulation
' This database has Employee Number, Name, Labor Entry(Dept no), and Total hours worked
' in each department - this only handles 2 departments, but can be expanded out to handle
' more.
Dim totRS As New ADODB.Recordset
Dim strDate
Dim strEmpNum1
Dim strLent1
Dim strTotal1 As String
Dim strTotal2 As String
Dim strTotal3 As String
Dim strTotal4 As String
Dim strTotal5 As String
Dim intHours As Integer
' variables for finding the decimal
Dim sInput As String
Dim sOutput As String
Dim sWorkingString As String
Dim sWorkingSingleCharacter
Dim sInput1 As String
Dim sOutput1 As String
Dim sWorkingString1 As String
Dim sWorkingSingleCharacter1
Dim n As Integer
Dim m As Integer
Dim myString As String
Dim myString1 As String
' string built to write to ASCII text file
Dim myData()
ReDim myData(0)
' Open database
Const myConn1 = "DSN=TOTALS;"
'
Set totRS = New ADODB.Recordset
totRS.ActiveConnection = myConn1
totRS.Open _
("SELECT * FROM TOTALS ORDER BY EMPNUM")
'Now declare a file object and create the text file to write to
Dim fso1 As New FileSystemObject, txtfile1
Set txtfile1 = fso1.CreateTextFile("C:\TOTALS.DATA", True)
If totRS.BOF And totRS.EOF Then
MsgBox "Recordset is empty", 16, "Empty Record"
Else
Do Until totRS.EOF
strTotal2 = "0000"
strEmpNum1 = totRS!EMPNUM
strEmpNum1 = Format(strEmpNum1, "000000")
strLent1 = totRS!LENT1
strDate = totRS!SDate
strDate = Format(strDate, "yyyymmdd")
strTotal1 = totRS!TOTAL_1
' DBF databases contain NULL values - check if value is NULL then
' turn it into a string value of blank which VB sees different than a NULL
If IsNull(totRS!TOTAL_2) Then
strTotal2 = ""
strTotal3 = strTotal1
strTotal3 = strTotal3 / 60 ' Convert minutes worked to hours
strTotal1 = Format(strTotal1, "00.00")
strTotal2 = Format(strTotal2, "00.00")
strTotal3 = Format(strTotal3, "00.00")
m = 0
sWorkingString1 = ""
' The following routine removes the decimal point from the
' field strTotal3. You must reset the variables each time through.
sInput1 = ""
' store input value into string and trim any control characters
sInput1 = Trim(strTotal3)
' get the length of that string just in case no . exists
For m = 1 To Len(sInput1)
' get one character at a time , m = starting charater
sWorkingSingleCharacter1 = Mid(sInput1, m, 1)
' if the character = a . then dont add to the string
If sWorkingSingleCharacter1 = "." Then GoTo skip:
'buld the string
sWorkingString1 = sWorkingString1 & sWorkingSingleCharacter1
skip:
Next
' soutput1 = the trucated string
sOutput1 = sWorkingString1
myString1 = sOutput1
myData(0) = strEmpNum1 & strLent1 & strDate & myString1
txtfile1.Write myData(0)
txtfile1.WriteLine
ReDim Preserve myData(UBound(myData) + 1)
totRS.MoveNext
Else ' there is a value in TOTAL_2 in TOTAL.DBF
strTotal5 = totRS!TOTAL_1
strTotal2 = totRS!TOTAL_2
' Convert the string to an integer so it can be added with the
' addition operator, otherwise it concantenates the strings.
strTotal5 = Val(strTotal5)
strTotal5 = strTotal5 / 60
strTotal5 = Format(strTotal5, "00.00")
strTotal2 = Val(strTotal2)
strTotal2 = strTotal2 / 60
strTotal2 = Format(strTotal2, "00.00")
strTotal4 = Val(strTotal4)
strTotal4 = Val(strTotal5) + Val(strTotal2)
strTotal4 = Format(strTotal4, "00.00")
' The following routine removes the decimal point from the
' field strTotal4. You must reset the variables back through
' store input value into string and trim any control characters
n = 0
sWorkingString = ""
sInput = ""
sInput = Trim(strTotal4)
' get the length of that string just in case no . exists
For n = 1 To Len(sInput)
' get one character at a time , i = starting charater
sWorkingSingleCharacter = Mid(sInput, n, 1)
' if the character = a . then dont add to the string
If sWorkingSingleCharacter = "." Then GoTo skip1:
'buld the string
sWorkingString = sWorkingString & sWorkingSingleCharacter
skip1:
Next
' soutput = the trucated string
sOutput = sWorkingString
myString = sOutput
myData(0) = strEmpNum1 & strLent1 & strDate & myString
txtfile1.Write myData(0)
txtfile1.WriteLine
ReDim Preserve myData(UBound(myData) + 1)
totRS.MoveNext
End If
Loop
txtfile1.Close
totRS.Close
End If
' Only message this program will display upon completion
' When Ok is clicked, the program will close.
MsgBox "Emp.DATA and Totals.DATA are ready.", vbMsgBoxRtlReading
End
End Sub
No comments have been posted about Written to access a dbf file and generate a flat ASCII text file, calculate employee hours and even. Why not be the first to post a comment about Written to access a dbf file and generate a flat ASCII text file, calculate employee hours and even.
