Hi,
I run the following code which loops through a recordset and performs a file copy based on a value in each record of the recordset. Given the value is a URL file link address its quite likely that the target file could get moved, deleted or changed which then creates an error, the code breaks and gives the user a warning.
In order to identify the source of the error quicker it would be useful to know how many iterations were successfully performed up until the break and include this info in the error MsgBox. Does anyone know how you can count the iterations and display the value in a MsgBox?
Thanks
I run the following code which loops through a recordset and performs a file copy based on a value in each record of the recordset. Given the value is a URL file link address its quite likely that the target file could get moved, deleted or changed which then creates an error, the code breaks and gives the user a warning.
In order to identify the source of the error quicker it would be useful to know how many iterations were successfully performed up until the break and include this info in the error MsgBox. Does anyone know how you can count the iterations and display the value in a MsgBox?
Thanks
Code:
Private Sub cmdCreateDatasheetsFolder_Click()
On Error GoTo ErrorHandler
Dim strSQL As String
Dim fsObject As Object
Dim rs As DAO.Recordset
Dim Cancel As Integer
Dim intStyle As String
Dim strTitle As String
Dim strMsg As String
Dim FoldernameDestROOT As String
Dim FoldernameDestFIRE As String
Dim FoldernameDestINTRUDER As String
Dim FoldernameDestACCESS As String
Dim FoldernameDestCCTV As String
Dim FoldernameDestOTHER As String
Dim createpath As String
Dim x, I As Integer
'Set folderpath for destinations of datasheet files
FoldernameDestROOT = "F:\SFA 20" & Right(Me.OrderDate, 2) & "\Running projects" & "\" & Me.CustomerID.Column(1) & "\J" & Me.OrderID & " " & Me.SiteName.Column(1) & "\OM MANUAL\"
FoldernameDestFIRE = "F:\SFA 20" & Right(Me.OrderDate, 2) & "\Running projects" & "\" & Me.CustomerID.Column(1) & "\J" & Me.OrderID & " " & Me.SiteName.Column(1) & "\OM MANUAL\DATASHEETS\FIRE\"
FoldernameDestINTRUDER = "F:\SFA 20" & Right(Me.OrderDate, 2) & "\Running projects" & "\" & Me.CustomerID.Column(1) & "\J" & Me.OrderID & " " & Me.SiteName.Column(1) & "\OM MANUAL\DATASHEETS\INTRUDER\"
FoldernameDestACCESS = "F:\SFA 20" & Right(Me.OrderDate, 2) & "\Running projects" & "\" & Me.CustomerID.Column(1) & "\J" & Me.OrderID & " " & Me.SiteName.Column(1) & "\OM MANUAL\DATASHEETS\ACCESS\"
FoldernameDestCCTV = "F:\SFA 20" & Right(Me.OrderDate, 2) & "\Running projects" & "\" & Me.CustomerID.Column(1) & "\J" & Me.OrderID & " " & Me.SiteName.Column(1) & "\OM MANUAL\DATASHEETS\CCTV\"
FoldernameDestOTHER = "F:\SFA 20" & Right(Me.OrderDate, 2) & "\Running projects" & "\" & Me.CustomerID.Column(1) & "\J" & Me.OrderID & " " & Me.SiteName.Column(1) & "\OM MANUAL\DATASHEETS\OTHER\"
strSQL = " SELECT [Quote Details].QuoteID, [Quote Details].ProductID, Products.ProductName, Products.DatasheetPath, (Mid(Nz(Products.DatasheetPath,""""),(InStrRev(Nz(Products.DatasheetPath,""""),""\"")+1),100)) AS Filename, Quotations.OrderNumber, Quotations.Discipline " & _
" FROM ([Quote Details] LEFT JOIN Products ON [Quote Details].ProductID = Products.ProductID) LEFT JOIN Quotations ON [Quote Details].QuoteID = Quotations.QuoteID " & _
" GROUP BY [Quote Details].QuoteID, [Quote Details].ProductID, Products.ProductName, Products.DatasheetPath, (Mid(Nz(Products.DatasheetPath,""""),(InStrRev(Nz(Products.DatasheetPath,""""),""\"")+1),100)), Quotations.OrderNumber, Quotations.Discipline " & _
" HAVING (((Quotations.OrderNumber)='" & Me.txtOrderNumber & "')) " & _
" ORDER BY (Mid(Nz(Products.DatasheetPath,""""),(InStrRev(Nz(Products.DatasheetPath,""""),""\"")+1),100));"
'Set the recordset and then loop through each product in returned recordset and copy each file at a time
Set rs = CurrentDb.OpenRecordset(strSQL)
Set fsObject = CreateObject("Scripting.FileSystemObject")
With rs
If Not .BOF And Not .EOF Then
.MoveLast
.MoveFirst
While (Not .EOF)
'rs.Edit
'rs!DatasheetPath = "2"
'rs.Update
If IsNull(rs!DatasheetPath) Or rs!DatasheetPath = "" Then
.MoveNext
ElseIf rs!Discipline = 1 Then 'FIRE
fsObject.CopyFile rs!DatasheetPath, FoldernameDestFIRE
.MoveNext
ElseIf rs!Discipline = 2 Then 'EVC
fsObject.CopyFile rs!DatasheetPath, FoldernameDestFIRE
.MoveNext
ElseIf rs!Discipline = 3 Then 'SUPPRESSION
fsObject.CopyFile rs!DatasheetPath, FoldernameDestFIRE
.MoveNext
ElseIf rs!Discipline = 4 Then 'EXTINGUISHERS
fsObject.CopyFile rs!DatasheetPath, FoldernameDestOTHER
.MoveNext
ElseIf rs!Discipline = 5 Then 'E LIGHTS
fsObject.CopyFile rs!DatasheetPath, FoldernameDestOTHER
.MoveNext
ElseIf rs!Discipline = 6 Then 'N CALL
fsObject.CopyFile rs!DatasheetPath, FoldernameDestOTHER
.MoveNext
ElseIf rs!Discipline = 7 Then 'FRA
fsObject.CopyFile rs!DatasheetPath, FoldernameDestOTHER
.MoveNext
ElseIf rs!Discipline = 8 Then 'INTRUDER
fsObject.CopyFile rs!DatasheetPath, FoldernameDestINTRUDER
.MoveNext
ElseIf rs!Discipline = 9 Then 'ACCESS
fsObject.CopyFile rs!DatasheetPath, FoldernameDestACCESS
.MoveNext
ElseIf rs!Discipline = 10 Then 'CCTV
fsObject.CopyFile rs!DatasheetPath, FoldernameDestCCTV
.MoveNext
ElseIf rs!Discipline = 11 Then 'MONITORING
fsObject.CopyFile rs!DatasheetPath, FoldernameDestOTHER
.MoveNext
ElseIf rs!Discipline = 12 Then 'REMEDIALS
fsObject.CopyFile rs!DatasheetPath, FoldernameDestOTHER
.MoveNext
End If
Wend
Else
.Close
MsgBox ("There are no quotes or products linked to this job")
GoTo ExitSub
End If
.Close
End With
Set fsObject = Nothing
Set rs = Nothing
Shell "C:\WINDOWS\explorer.exe """ & FoldernameDestFIRE & "", vbNormalFocus
MsgBox ("All datasheets copied to projects folder")
GoTo ExitSub
ExitSub:
Set rs = Nothing
Set fsObject = Nothing
Exit Sub
ErrorHandler:
MsgBox "An ERROR has occured, it could be a product with incorrect datasheet link. The copy in alpabetical order, check to see which product was the last" _
& "succesfully copied and then check the datasheet link in the next item in the product test list"
Resume ExitSub
End Sub