Any particular reason why you are using an ADO recordset and not DAO? Assuming the Directory_Files table is linked (based on the attempt to use dCount on it), here is how I would have tried to do it:
Code:
Sub zzzTemp3_Directory(Path, _
Optional Pattern As String = "*.*", _
Optional UseLocalConnection As Boolean)
On Error GoTo ErrorHandler
'Do the equivalent of a DOS Dir command and place the results in a table.
Const kThisProcedure = "zzzTemp3_Directory"
'Dim cn As New ADODB.Connection
Dim rs As DAO.Recordset 'New ADODB.Recordset
Dim db as DAO.Database
Dim WRK_Counter
Dim WRK_Counter_Files
Dim WRK_Counter_SubDirectories
Dim WRK_FileDateTime
Dim WRK_FileLength
Dim WRK_Name
Dim WRK_Type
Set db=CurrentDb
'clear table
db.Execute "Delete * From Directory_Files;",dbFailOnError
Set rs=db.OpenRecordset("Directory_Files",dbOpenDynaset)
' If UseLocalConnection Then
' cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=<Fully-qualified-back-end.AccDB>"
' cn.Execute "Delete From Directory_Files"
' rs.Open "Directory_Files", cn, adOpenForwardOnly, adLockPessimistic
' Else
' CheckConnection p_cn '(p_cn is a global/public ADODB.Connection; CheckConnection just makes sure it is valid; using the local vs public connection did not isolate anything for me)
' p_cn.Execute "Delete From Directory_Files"
' rs.Open "Directory_Files", p_cn, adOpenForwardOnly, adLockPessimistic
' End If
WRK_Counter = 0
WRK_Name = Dir(Path & "\" & Pattern, vbDirectory)
Do While WRK_Name <> ""
If Left(WRK_Name, 1) <> "." Then
WRK_Counter = WRK_Counter + 1
WRK_FileDateTime = FileDateTime(Path & "\" & WRK_Name)
WRK_FileLength = FileLen(Path & "\" & WRK_Name)
WRK_Type = GetAttr(Path & "\" & WRK_Name) And vbDirectory
'The entry returned was a DIRECTORY.
If WRK_Type Then
'The entry returned was a FILE.
Else
WRK_Counter_Files = WRK_Counter_Files + 1
rs.AddNew
rs("Path") = IIf(Len(Path) > 255, Left(Path, 252) & "...", Path)
rs("FileName") = IIf(Len(WRK_Name) > 255, Left(WRK_Name, 252) & "...", WRK_Name)
rs("Modified") = IIf(WRK_FileDateTime < #1/1/1900#, #1/1/1900#, WRK_FileDateTime)
rs("Length") = WRK_FileLength
rs("Current") = Now()
rs.Update
End If
End If
WRK_Name = Dir
DoEvents
Loop
Debug.Print kThisProcedure & " DCount(*,Directory_Files) = " & DCount("*", "Directory_Files")
' Debug.Print kThisProcedure & " RecordCount(Directory_Files) = " & RecordCount("Directory_Files") '(RecordCount uses ADO to get the count; neither method worked or failed 100% of the time)
GoTo CleanUp
ErrorHandler:
Select Case Err.Number
Case Else
Dim vErrorReply
vErrorReply = MsgBox(Err.Description, vbAbortRetryIgnore, "Error " & Err.Number & " (Abort = Stop)")
If vErrorReply = vbAbort Then Stop
If vErrorReply = vbIgnore Then Resume Next
If vErrorReply = vbRetry Then Resume
End Select
CleanUp:
rs.Close
If Not rs Is Nothing Then Set rs = Nothing
' If Not cn.State = adStateClosed Then cn.Close
' If Not cn Is Nothing Then Set cn = Nothing
set db=Nothing
End Sub
Cheers,