Macro "Action Failed"

[JLeo]

Hi,

I have this strange problem. My module code runs perfectly fine when i press the 'play' button on the VB edit screen. However when i attempt to run this code as a time automated macro to update my tables, it keeps giving this error screen stating: Action Failed for Macro.

I've went through the codes a few times to ensure proper functioning and no problem was detected. I've also tried to paste this code as a subroutine on the 'On Open Event'of the start page to automatically update data when db is open, but istead the db doesnt even open at all. Can anyone please advice?

Function StoreNames()
Dim I As Integer
Dim strFileloc As String
Dim strPhase As String
Dim strCategory As String
Dim strLocation As String
Dim strFilename As String
Dim II As Integer
Dim X As Integer
Dim lngSpos(1 To 5) As Long
Dim rst As DAO.Recordset
Dim db As Database


DoCmd.RunSQL "Delete * from tblNewSiteDoc;"

Set db = CurrentDb
Set rst = db.OpenRecordset("tblNewSiteDoc&quot

With Application.FileSearch
.LookIn = "L:\New Site Documentation\"
.SearchSubFolders = True
.FileType = msoFileTypeWordDocuments
If .Execute() > 0 Then
'MsgBox "There were " & .FoundFiles.Count & " file(s) found."
For I = 1 To .FoundFiles.Count
'For I = 1 To 100
If .FoundFiles(I) Like "*" & ".doc" Then
strFileloc = (.FoundFiles(I))
'MsgBox .FoundFiles(I)
GoTo a1
'MsgBox strFileloc
End If
rst.Close
Set rst = Nothing
db.Close
Set db = Nothing
End
a2:
Next I
Else
MsgBox "There were no files found."
End
End If
End
End With

End

a1: 'find the position of all the slashes assumes five
For II = 1 To Len(strFileloc)
If Mid(strFileloc, II, 1) = "\" Then
X = X + 1
lngSpos(X) = II + 1
End If
Next II
strPhase = Mid(strFileloc, lngSpos(2), (lngSpos(3) - lngSpos(2)) - 1)
strLocation = Mid(strFileloc, lngSpos(3), (lngSpos(4) - lngSpos(3)) - 1)
strCategory = Mid(strFileloc, lngSpos(4), (lngSpos(5) - lngSpos(4)) - 1)
strFilename = Mid(strFileloc, lngSpos(5))
On Error GoTo a3:
With rst
.AddNew
.Fields("PhaseNo&quot = strPhase
.Fields("Sector&quot = strLocation
.Fields("Category&quot = strCategory
.Fields("FileName&quot = strFilename
.Update
a3:
X = 0
GoTo a2
End With
End Function

 

[JLeo]

Hi,

After some help, managed to find that small error highlighted in bold. Always helpful to have someone else to help check for errors. Thanks KC.

End If
rst.Close
Set rst = Nothing
db.Close
Set db = Nothing
Exit Function(Instead of END)
a2:
Next I
Else
MsgBox "There were no files found."
End
End If
Exit Function(Instead of END)
End With