CevinMoses
New member
- Local time
- Today, 00:59
- Joined
- Sep 17, 2010
- Messages
- 6
We are migrating from Access 2000 to Access 2010, primarily because of how easy it is to export pdf files of everything we print, but now the Application.FileSearch line returns a run-time error '2455'. From what I can tell, it is no longer supported with Access 2010, but I am having trouble finding a new method of listing the files in a certain directory that meet a certain requirement (date and .txt extension). What new tool should I use to search for files and populate a list box?
Here's the original code, which worked when I last worked on this six months ago.
Sub FindAllFilesInFolder()
'Perform simple search using filesearch object
Dim varItem As Variant
Dim Folder As String
Dim objDB As Database
Dim i As Integer
Dim bFlag As Boolean
Dim StrListItems As String
Dim FolderLength As Integer
Dim fName As String
Dim stFileName As String
Dim stDateFilter As Integer
DoCmd.SetWarnings False
DoCmd.RunSQL "Delete * from tblFoundFiles"
DoCmd.SetWarnings True
Set objDB = CurrentDb
dblocation = Me.TxtInitDir
Folder = dblocation
StrListItems = "'"
stDateFilter = DLookup("[msoDateFilter]", "[tMsoDateFilter]", "[DateFilter] = '" & Me.DateFilter & "'")
With Application.FileSearch
.NewSearch
stFileName = Nz(Me.TxtFilter, "") & "*." & Nz(Me.TxtExtension, "") & "*"
.FileName = stFileName
.LastModified = stDateFilter
Debug.Print "LastModified = " & .LastModified
.LookIn = Folder
.Execute
DoCmd.SetWarnings False
For Each varItem In .FoundFiles
FolderLength = Len(Folder) + 1
fName = Mid(varItem, FolderLength + 1)
Debug.Print vbCrLf & StrListItems
StrListItems = StrListItems & fName & "','" & Folder & "','"
DoCmd.RunSQL "INSERT INTO tblFoundFiles ( FilePath , FileName ) SELECT '" & Folder & "\" & "' AS A, '" & fName & "' AS B;"
bFlag = True
Next varItem
DoCmd.SetWarnings True
End With
objDB.Close
Set objDB = Nothing
Me.LstFoundFiles.RowSource = "QryFoundFiles"
If Me.LstFoundFiles.ListCount > 0 Then
Me.LstFoundFiles.Enabled = True
Me.LstFoundFiles.Locked = False
Me.Import850.Enabled = True
Else
Me.LstFoundFiles.Enabled = False
Me.LstFoundFiles.Locked = True
Me.Import850.Enabled = False
End If
End Sub
Thanks,
Cevin
Here's the original code, which worked when I last worked on this six months ago.
Sub FindAllFilesInFolder()
'Perform simple search using filesearch object
Dim varItem As Variant
Dim Folder As String
Dim objDB As Database
Dim i As Integer
Dim bFlag As Boolean
Dim StrListItems As String
Dim FolderLength As Integer
Dim fName As String
Dim stFileName As String
Dim stDateFilter As Integer
DoCmd.SetWarnings False
DoCmd.RunSQL "Delete * from tblFoundFiles"
DoCmd.SetWarnings True
Set objDB = CurrentDb
dblocation = Me.TxtInitDir
Folder = dblocation
StrListItems = "'"
stDateFilter = DLookup("[msoDateFilter]", "[tMsoDateFilter]", "[DateFilter] = '" & Me.DateFilter & "'")
With Application.FileSearch
.NewSearch
stFileName = Nz(Me.TxtFilter, "") & "*." & Nz(Me.TxtExtension, "") & "*"
.FileName = stFileName
.LastModified = stDateFilter
Debug.Print "LastModified = " & .LastModified
.LookIn = Folder
.Execute
DoCmd.SetWarnings False
For Each varItem In .FoundFiles
FolderLength = Len(Folder) + 1
fName = Mid(varItem, FolderLength + 1)
Debug.Print vbCrLf & StrListItems
StrListItems = StrListItems & fName & "','" & Folder & "','"
DoCmd.RunSQL "INSERT INTO tblFoundFiles ( FilePath , FileName ) SELECT '" & Folder & "\" & "' AS A, '" & fName & "' AS B;"
bFlag = True
Next varItem
DoCmd.SetWarnings True
End With
objDB.Close
Set objDB = Nothing
Me.LstFoundFiles.RowSource = "QryFoundFiles"
If Me.LstFoundFiles.ListCount > 0 Then
Me.LstFoundFiles.Enabled = True
Me.LstFoundFiles.Locked = False
Me.Import850.Enabled = True
Else
Me.LstFoundFiles.Enabled = False
Me.LstFoundFiles.Locked = True
Me.Import850.Enabled = False
End If
End Sub
Thanks,
Cevin