Private Sub cmdCreateDatasheetsFolder_Click()
'On Error GoTo ErrorHandler
Dim strSQL As String
Dim fsObject As Object
Dim rs As DAO.Recordset
Dim NewPath As String
Dim Cancel As Integer
Dim intStyle As String
Dim strTitle As String
Dim strMsg As String
Dim Foldername As String
Dim FoldernameDest As String
Dim createpath As String
Dim X, I As Integer
'Set folderpath for destination of datasheet files
FoldernameDest = "F:\SFA 20" & Right(Me.OrderDate, 2) & "\Running projects" & "\" & Me.CustomerID.Column(1) & "\J" & Me.OrderID & " " & Me.SiteName.Column(1) & "\OM Manual\Datasheets\"
'Check to see if above directory has been previously created
If FolderExists(FoldernameDest) = False Then
'If it hasnt create the folder
Foldername = "F:\SFA 20" & Right(Me.OrderDate, 2) & "\Running projects"
createpath = Foldername & "\" & Me.CustomerID.Column(1) & "\J" & Me.OrderID & " " & Me.SiteName.Column(1) & "\OM Manual\Datasheets\"
Call MakeDirectory(createpath)
'MkDir (createpath)
Foldername = createpath
'run query to find all products on all quotes linked to job and return their respective datasheet URLs
strSQL = " SELECT [Quote Details].QuoteID, [Quote Details].ProductID, Products.DatasheetPath, Quotations.OrderNumber " & _
" 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.DatasheetPath, Quotations.OrderNumber " & _
" HAVING (((Quotations.OrderNumber)='" & Me.txtOrderNumber & "'));"
'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")
NewPath = FoldernameDest
'NewPath = "c:\tempfolderB\"
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
Else
fsObject.CopyFile rs!DatasheetPath, NewPath
.MoveNext
End If
'.MoveNext
Wend
Else
'.Close
'Set rs = Nothing
'Set fsObject = Nothing
MsgBox ("There are no quotes or products linked to this job")
GoTo ExitSub
End If
.Close
End With
Shell "C:\WINDOWS\explorer.exe """ & FoldernameDest & "", vbNormalFocus
MsgBox ("All datasheets copied to projects folder")
Else
'run query to find all products on all quotes linked to job and return their respective datasheet URLs
strSQL = " SELECT [Quote Details].QuoteID, [Quote Details].ProductID, Products.DatasheetPath, Quotations.OrderNumber " & _
" 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.DatasheetPath, Quotations.OrderNumber " & _
" HAVING (((Quotations.OrderNumber)='" & Me.txtOrderNumber & "'));"
'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")
NewPath = FoldernameDest
'NewPath = "c:\tempfolderB\"
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
Else
fsObject.CopyFile rs!DatasheetPath, NewPath
.MoveNext
End If
'.MoveNext
Wend
Else
'.Close
'Set rs = Nothing
'Set fsObject = Nothing
MsgBox ("There are no quotes or products linked to this job")
GoTo ExitSub
End If
.Close
End With
Shell "C:\WINDOWS\explorer.exe """ & FoldernameDest & "", vbNormalFocus
MsgBox ("All datasheets copied to projects folder GGGGGGGGGGGGGGG")
End If
GoTo ExitSub
ExitSub:
Set rs = Nothing
Set fsObject = Nothing
Exit Sub
ErrorHandler:
MsgBox "None of the linked products had datasheets assigned"
Resume ExitSub
End Sub