D
David A
I have a routine in Access VBA that imports data for a set of clients each
of whom have their data files in their own directory. So client 1234 has its
relevant data files in C:\data\1234, and client 1235 in C:\data\1235, and so
forth.
The routine below works perfectly on my test system (Access 2003 SP2, W2000
Pro) but on the production system it mysteriously jumps out of the loop for
some clients, seemingly at random. The production system has an identical
setup with Access 2003 and Windows 2000, the only difference being that the
S: drive on their system is a shared network drive and on my test system
it's on my local hard drive.
The main loop for each ClientID always works and completes correctly without
any error being raised. But, at random, the "Do While Len(sFileName) > 0"
loop in "ImportForClient" seems to just exit the loop and returns control
immediately to the main function without raising an error. You can only
detect it by examining the log. I had initially thought that "DoEvents" was
the cause. All I can think of is that the "Dir" command is causing a
problem.
Any suggestions?
=====(code)=====
Public Function ImportAll() As Long
On Error GoTo HandleError
Dim sQry As String
Dim rs As DAO.Recordset
Dim nRecs As Long
Dim nUpdated As Long
sQry = "SELECT ClientID FROM tblClients;"
Set rs = CurrentDb().OpenRecordset(sQry, dbOpenForwardOnly, dbReadOnly)
With rs
Do Until .EOF
nRecs = ImportForClient(!ClientID, "S:\data")
If nRecs > 0 Then
nUpdated = nUpdated + 1
End If
.MoveNext
Loop
.Close
End With
Set rs = Nothing
WriteLog "Auto-import completed: " & nUpdated & " accounts were
updated."
ImportAll = nUpdated
Done:
Exit Function
HandleError:
Call AppErrHandler(scMODNAME, "ImportAll")
Resume Done
End Function
Public Function ImportForClient(sClientID As String, sRootPath As String) As
Long
On Error GoTo HandleError
Dim sPath As String
Dim sFileName As String
Dim sMsg As String
Dim nRead As Long
Dim nTotRead As Long
Dim nFiles As Long
Dim n As Long
Dim sQry As String
sMsg = "Processing Import for client " & sClientID
WriteLog sMsg
DoEvents
' Read in records for all CSV files we find in dir
sPath = sRootPath & "\" & sClientID & "\"
sFileName = Dir(sPath & "*.csv")
Do While Len(sFileName) > 0
sFileName = sPath & sFileName
nFiles = nFiles + 1
sMsg = " Reading file: " & sFileName
WriteLog sMsg
nRead = ImportCSVFile(sFileName)
If nRead < 0 Then
sMsg = "ERROR: occurred reading file " & sFileName
sMsg = sMsg & ": " & ImportErrorMsg(nRead)
Else
sMsg = " ...found " & nRead & " valid records."
nTotRead = nTotRead + nRead
End If
WriteLog sMsg
'**************************************************
' REACHES HERE OK BUT SOMETIMES `JUMPS' OUT OF LOOP
'**************************************************
sFileName = Dir
Loop
' IF JUMPED OUT, IT NEVER REACHES HERE...
WriteLog " Read " & nFiles & " files for client " & sClientID & ": " &
nTotRead & " records found."
ImportForClient = nTotRead
Done:
Exit Function
HandleError:
Call AppErrHandler(scMODNAME, "ImportForClient")
Resume Done
End Function
of whom have their data files in their own directory. So client 1234 has its
relevant data files in C:\data\1234, and client 1235 in C:\data\1235, and so
forth.
The routine below works perfectly on my test system (Access 2003 SP2, W2000
Pro) but on the production system it mysteriously jumps out of the loop for
some clients, seemingly at random. The production system has an identical
setup with Access 2003 and Windows 2000, the only difference being that the
S: drive on their system is a shared network drive and on my test system
it's on my local hard drive.
The main loop for each ClientID always works and completes correctly without
any error being raised. But, at random, the "Do While Len(sFileName) > 0"
loop in "ImportForClient" seems to just exit the loop and returns control
immediately to the main function without raising an error. You can only
detect it by examining the log. I had initially thought that "DoEvents" was
the cause. All I can think of is that the "Dir" command is causing a
problem.
Any suggestions?
=====(code)=====
Public Function ImportAll() As Long
On Error GoTo HandleError
Dim sQry As String
Dim rs As DAO.Recordset
Dim nRecs As Long
Dim nUpdated As Long
sQry = "SELECT ClientID FROM tblClients;"
Set rs = CurrentDb().OpenRecordset(sQry, dbOpenForwardOnly, dbReadOnly)
With rs
Do Until .EOF
nRecs = ImportForClient(!ClientID, "S:\data")
If nRecs > 0 Then
nUpdated = nUpdated + 1
End If
.MoveNext
Loop
.Close
End With
Set rs = Nothing
WriteLog "Auto-import completed: " & nUpdated & " accounts were
updated."
ImportAll = nUpdated
Done:
Exit Function
HandleError:
Call AppErrHandler(scMODNAME, "ImportAll")
Resume Done
End Function
Public Function ImportForClient(sClientID As String, sRootPath As String) As
Long
On Error GoTo HandleError
Dim sPath As String
Dim sFileName As String
Dim sMsg As String
Dim nRead As Long
Dim nTotRead As Long
Dim nFiles As Long
Dim n As Long
Dim sQry As String
sMsg = "Processing Import for client " & sClientID
WriteLog sMsg
DoEvents
' Read in records for all CSV files we find in dir
sPath = sRootPath & "\" & sClientID & "\"
sFileName = Dir(sPath & "*.csv")
Do While Len(sFileName) > 0
sFileName = sPath & sFileName
nFiles = nFiles + 1
sMsg = " Reading file: " & sFileName
WriteLog sMsg
nRead = ImportCSVFile(sFileName)
If nRead < 0 Then
sMsg = "ERROR: occurred reading file " & sFileName
sMsg = sMsg & ": " & ImportErrorMsg(nRead)
Else
sMsg = " ...found " & nRead & " valid records."
nTotRead = nTotRead + nRead
End If
WriteLog sMsg
'**************************************************
' REACHES HERE OK BUT SOMETIMES `JUMPS' OUT OF LOOP
'**************************************************
sFileName = Dir
Loop
' IF JUMPED OUT, IT NEVER REACHES HERE...
WriteLog " Read " & nFiles & " files for client " & sClientID & ": " &
nTotRead & " records found."
ImportForClient = nTotRead
Done:
Exit Function
HandleError:
Call AppErrHandler(scMODNAME, "ImportForClient")
Resume Done
End Function