Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Strange VB coding problem(cant run as macro)

Status
Not open for further replies.

JLeo

Technical User
Feb 10, 2003
44
US
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 page(form) 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")

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") = strPhase
.Fields("Sector") = strLocation
.Fields("Category") = strCategory
.Fields("FileName") = strFilename
.Update
a3:
X = 0
GoTo a2
End With
End Function
 
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
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top