• Home
 · 
• Databases/Data Access/DAO/ADO
 · 
• Written to access a dbf file and generate a flat ASCII text file, calculate employee hours and even

Written to access a dbf file and generate a flat ASCII text file, calculate employee hours and even

Written to access a dbf file and generate a flat ASCII text file, calculate employee hours and eventually write the data directly to a

Rate Written to access a dbf file and generate a flat ASCII text file, calculate employee hours and even

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

' 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