discogs
asked on
VBA File System Object Error - Line 52
Hi,
I am upgrading an old access 2003 database to 2010 and am having some issues with using the file system object. My references are all set correctly to Office14.0.
Can anyone help with a solution to the error I am getting on line 52?
I am upgrading an old access 2003 database to 2010 and am having some issues with using the file system object. My references are all set correctly to Office14.0.
Can anyone help with a solution to the error I am getting on line 52?
Sub ListFilesInFolder()
'** empty the temp table TT_FILE_LIST
'** add the files in the TT_FILE_LIST table with print status set to "not printed"
'** If the file has the timestamp PRTxxxx then put status "printed [xxxxxx]"
Dim dbFailOnError
Dim rs As New ADODB.Recordset
Dim Conn As ADODB.Connection
Set Conn = CurrentProject.AccessConnection
Dim strSQL As String, i, iFileName
Dim vAutoPrintDirectory, vAutoPrintFileExtension, totalFiles, strCurFile, vFileNameNoExt
Dim vSearch, vSearchDate, vPrintingStatus, vPrintingStatusFlag
DoCmd.SetWarnings False
'** set the vGetFileProcessing to true (= processing)
vGetFileProcessing = True
'Get the printing
strSQL = "SELECT MT_PRINTING_SETTINGS.AutoPrintDirectory, MT_HANDLER_SETTINGS.HandlerFileExtension FROM MT_PRINTING_SETTINGS INNER JOIN MT_HANDLER_SETTINGS ON MT_PRINTING_SETTINGS.AutoPrintHandlerID = MT_HANDLER_SETTINGS.HandlerID"
rs.Open strSQL, Conn, adOpenKeyset, adLockOptimistic
If rs.RecordCount > 0 Then
rs.MoveFirst
vAutoPrintDirectory = rs.Fields("AutoPrintDirectory")
vAutoPrintFileExtension = rs.Fields("HandlerFileExtension")
End If
Set rs = Nothing
'Make sure the folder setting is in the table
If IsNull(vAutoPrintDirectory) = True Then
Call showProcessStatus("UF_DASHBOARD", Chr(13) & Chr(10) & "Please select a folder where to look for files..", 1)
Call hideProcessStatus("UF_DASHBOARD", 2)
Exit Sub
End If
'Make sure the extension setting is in the table
If IsNull(vAutoPrintFileExtension) = True Then
Call showProcessStatus("UF_DASHBOARD", Chr(13) & Chr(10) & "Please select a file extension..", 1)
Call hideProcessStatus("UF_DASHBOARD", 2)
Exit Sub
End If
'Empty the TT_FILE_LIST table
Call showProcessStatus("UF_DASHBOARD", "Collecting files from : " & vAutoPrintDirectory, 0)
strSQL = "DELETE FROM TT_FILE_LIST"
rs.Open strSQL, Conn, adOpenKeyset, adLockOptimistic
Set rs = Nothing
'Loop through files in specific folder and add them to the TT_FILE_LIST table
With Application.FileSearch 'ERRORS HERE
.NewSearch
.LookIn = vAutoPrintDirectory
.SearchSubFolders = False
.FileName = "*." & vAutoPrintFileExtension
If .Execute() > 0 Then
totalFiles = .FoundFiles.Count
For i = 1 To totalFiles
'fnWait (1)
strCurFile = .FoundFiles(i)
iFileName = GetFilenameFromPath(strCurFile)
Call showProcessStatus("UF_DASHBOARD", Chr(13) & Chr(10) & "File " & i & "/" & totalFiles & " : " & iFileName, 0)
DoEvents
'*** CANCEL the search
If vGetFileProcessing = False Then
Call EmptyFileList
Call PopulateFileList("FileNameListBox")
'Update the value of the selected files
Forms![UF_DASHBOARD].Controls("SelectedFileCountText").Value = Forms![UF_DASHBOARD].Controls("FileNameListBox").ItemsSelected.Count
'Update the value of the found files
Forms![UF_DASHBOARD].Controls("TotalFileCountText").Value = GetTotalFileInList
'Update the value of the printed files
Forms![UF_DASHBOARD].Controls("PrintedFileCountText").Value = 0
Call showProcessStatus("UF_DASHBOARD", Chr(13) & Chr(10) & "File collection aborted.", 1)
'Add the print file in the log table
Call AddDBLog("Cancel", "File search", "File search aborted")
Call hideProcessStatus("UF_DASHBOARD", 2)
Exit Sub
End If
'Check file name for printed information
vPrintingStatus = "Not printed"
vPrintingStatusFlag = 0
'If the filename (without extension) is longer than 12, capture the last 12 characters before the file extension
vFileNameNoExt = Left(iFileName, Len(iFileName) - 4)
If (Len(vFileNameNoExt) > 12) Then
vSearch = InStrRev(vFileNameNoExt, "_PRT", -1, vbTextCompare)
If vSearch = (Len(iFileName) - 15) Then
vSearchDate = Mid(vFileNameNoExt, vSearch + 4, (vSearch + 8))
vPrintingStatus = "Printed (" & Right(vSearchDate, 2) & "/" & Mid(vSearchDate, 5, 2) & "/" & Left(vSearchDate, 4) & ")"
vPrintingStatusFlag = 1
End If
End If
'Add the record in the table
strSQL = "INSERT INTO TT_FILE_LIST ( FileName, FilePath, FilePrintStatus, FilePrintStatusFlag ) " & _
"VALUES (" & Chr(34) & iFileName & Chr(34) & "," & Chr(34) & vAutoPrintDirectory & Chr(34) & "," & Chr(34) & vPrintingStatus & Chr(34) & "," & vPrintingStatusFlag & ")"
rs.Open strSQL, Conn, adOpenKeyset, adLockOptimistic
Set rs = Nothing
Next i
Else
Call showProcessStatus("UF_DASHBOARD", "No files were found!" & Chr(13) & Chr(10) & "Please make sure the path and file type are correct.", 1)
'Closes the process status after 2 seconds
Call hideProcessStatus("UF_DASHBOARD", 2)
End If
'Closes the process status after 1 second
Call hideProcessStatus("UF_DASHBOARD", 1)
End With
'Update the value of the found files
Forms![UF_DASHBOARD].Controls("TotalFileCountText").Value = GetTotalFileInList
'Update the value of the printed files
Forms![UF_DASHBOARD].Controls("PrintedFileCountText").Value = GetTotalFilePrinted
Forms![UF_DASHBOARD].Controls("BtnSearchFiles").Caption = "Search for files"
'Log
Call AddDBLog("Success", "File search", GetTotalFileInList & " files found in " & vAutoPrintDirectory)
vGetFileProcessing = False
End Sub
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER