Sub ReadFromTextFile()
Dim fs As Scripting.FileSystemObject, f As Scripting.TextStream
Dim l As Long, sPathFile As String, iDel As Long
Dim Rst As Object
Dim arrFieldnames As Variant
Dim arrValues As Variant
Dim iCon As Long
Dim sStaffCode$, sDate$, sTime$, vInOut, sTemp$
On Error GoTo ErrorHandler
iCon = ConnectToDB
If iCon = 1 Then
gcnAccess.Open
sPathFile = ThisWbPath() & csData_File_Name
'Clear the data before importing
iDel = DeleteTable(gcnAccess, "TB_TimeInOutTemp")
If iDel <> 1 Then
MsgBox "Can not delete the data." & vbCrLf & _
"Please check with author.", vbOKOnly + vbCritical, mcsAppName
GoTo ErrorExit
End If
'recordset
Set Rst = CreateObject("ADODB.Recordset")
'
'CursorTypeEnum
'adOpenDynamic = 2
'adOpenForwardOnly = 0
'adOpenKeySet = 1
'adOpenStatic = 3
'
'The CursorLocationEnum:
'adUseClient = 3
'adUseServer = 2
'
'LockTypeEnum:
'adLockReadOnly = 1
'adLockPessimistic = 2
'adLockOptimistic = 3
'adLockBatchOptimistic = 4
'
'Rst.CursorLocation = adUseClient
Rst.CursorLocation = 3
'Rst.Open "TB_TimeInOutTemp", gcnAccess, adOpenStatic, adLockBatchOptimistic
Rst.Open "TB_TimeInOutTemp", gcnAccess, 3, 4
Set fs = New Scripting.FileSystemObject
Set f = fs.OpenTextFile(sPathFile, _
ForReading, False)
arrFieldnames = Array("StaffCode", "WorkDate", _
"TimeInOut", "InOutCode")
With f
l = 0
While Not .AtEndOfStream
l = l + 1
sTemp = .ReadLine
sStaffCode = Mid(sTemp, 1, 5)
If Val(sStaffCode) > 8380 And Val(sStaffCode) <> 11111 Then
'Format as dd/mm/yyyy
sDate = Mid(sTemp, 15, 2) & "/" & Mid(sTemp, 12, 2) & "/" & Mid(sTemp, 7, 4)
'dDate = "#" & sDate & "#"
sTime = sDate & " " & Mid(sTemp, 18, 5)
vInOut = Mid(sTemp, 26, 8): vInOut = Val(vInOut)
arrValues = Array(sStaffCode, sDate, sTime, vInOut)
Rst.AddNew arrFieldnames, arrValues
End If
Application.StatusBar = "Reading to record " & l
Wend
Application.StatusBar = "Batch updating. Please wait."
Rst.UpdateBatch
'Close the recordset
Rst.Close
'Close the TextStream
.Close
End With
Else
MsgBox "Can not connect to database." & vbCrLf & _
"Pls contact the author.", vbCritical + vbOKOnly, mcsAppName
End If
ErrorExit:
Application.StatusBar = False
gcnAccess.Close
Set f = Nothing
Set fs = Nothing
Set Rst = Nothing
Exit Sub
ErrorHandler:
RecordErrors "mIniLogFile", "ReadFromTextFile", False
RecordErrorsConnection gcnAccess, False
Resume ErrorExit
End Sub
