I have recently changed from office 2003 to 2010. With that change a script that I have painstakenly just gotten to work, now won't work.
Can someone offer assistance in editing the code below to replace the "Application.File Search?
Can someone offer assistance in editing the code below to replace the "Application.File Search?
Code:
Private Sub Form_Open(Cancel As Integer)
'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
DoCmd.SetWarnings False
DoCmd.RunSQL "Delete * from tblFoundFiles"
DoCmd.SetWarnings True
Set objDB = CurrentDb
dblocation = "C:\Project_Photos"
Folder = dblocation
StrListItems = "'"
With Application.FileSearch
.NewSearch
.FileName = "*"
.LookIn = Folder
.Execute
DoCmd.SetWarnings False
For Each varItem In .FoundFiles
FolderLength = Len(Folder) + 1
fName = Mid(varItem, FolderLength + 1)
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
If bFlag = True Then
'Drop the last seperators
'pass the results back to the list box on the screen
Me.LstFoundFiles.RowSource = "QryFoundFiles"
If Me.LstFoundFiles.ListCount > 0 Then
Me.LstFoundFiles.Enabled = True
Me.LstFoundFiles.Locked = False
Else
Me.LstFoundFiles.Enabled = False
Me.LstFoundFiles.Locked = True
End If
End If
End Sub