Hi all,
just a revisit on emailing a PDF
A user entered the incorrect password
We received and error message but not the required message in term off "Incorrect password, pleas try again"
Also, the code closed the form and continued with the process with out sending the email of Couse.
I need the password field o be cleared and then to be enabled to retype the password
The password must first be authenticated before the macro to run queries are active
Please could you assist
just a revisit on emailing a PDF
A user entered the incorrect password
We received and error message but not the required message in term off "Incorrect password, pleas try again"
Also, the code closed the form and continued with the process with out sending the email of Couse.
I need the password field o be cleared and then to be enabled to retype the password
The password must first be authenticated before the macro to run queries are active
Please could you assist
Private Sub Excecute_Click()
Dim SQL As String
Dim WPassStr As String
Dim sSQL As String
'Check Gmail Settings
If Nz(DLookup("[WPass]", "[GMailSettingsQry]")) = "" Then
DoCmd.OpenForm "Airbus Mail Frm - New DAW"
Exit Sub
End If
'Enter Password
If Nz(DLookup("[WPass]", "[GMailSettingsQry]")) = "" Then
DoCmd.Hourglass True
DoCmd.SetWarnings False
DoCmd.OpenQuery "Delete blank Entries - DAW Status", acViewNormal, acEdit
DoCmd.OpenQuery "Clear_Registration_File", acViewNormal, acEdit
DoCmd.OpenQuery "Update_Registration_All", acViewNormal, acEdit
DoCmd.SetWarnings True
Exit Sub
End If
Dim rs As Recordset
Dim rss As Recordset
Dim vMsg As String
Dim vSubject As String
Dim vReportPDF As String
'Obtain the email address for the current user email - "From" email
vRecipientListFrom = Nz(DLookup("CurrentUserMail", "[GMailSettingsQry]")) 'Vlad:this line replaces the entire commented out block below
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<NOT NEEDED - REMOVE>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'Set rss = CurrentDb.OpenRecordset("SELECT * FROM GMailSettingsQry; ")
'If rss.RecordCount > 0 Then
'rss.MoveFirst
''Do Until rss.EOF 'Vlad - makes it easier to follow to code -commented out as this has only one record so no need to loop
'If Not IsNull(rss!CurrentUserMail) Then vRecipientListFrom = vRecipientListFrom & rss("CurrentUserMail")
''vRecipientListFrom is not used anywhere, I think it should be in this line:SendEMailCDO vRecipientList, scc, vSubject, vMsg, "", vReportPDF
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<NOT NEEDED - REMOVE>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'Obtain all the cc addresses
Set rs = CurrentDb.OpenRecordset("SELECT * FROM EmailTBLQry_NewDaw; ")
If rs.RecordCount > 0 Then rs.MoveFirst
Do Until rs.EOF
'Set To Recipient
If Not IsNull(rs!To) Then vRecipientList = vRecipientList & rs("To") & ","
'Set CC Recipient
If Not IsNull(rs!ProjectLeaderMail) And rs!ProjectLeaderMail <> "N/A" Then aProjectLeaderMail = aProjectLeaderMail & rs("ProjectLeaderMail") & ","
If Not IsNull(rs!ProductionPlannerMail) And rs!ProductionPlannerMail <> "N/A" Then aProductionPlannerMail = aProductionPlannerMail & rs("ProductionPlannerMail") & ","
If Not IsNull(rs!MaterialPlannerMail) And rs!MaterialPlannerMail <> "N/A" Then aMaterialPlannerMail = aMaterialPlannerMail & rs("MaterialPlannerMail") & ","
If Not IsNull(rs!CurrentUserMail) And rs!CurrentUserMail <> "N/A" Then aCurrentUserMail = aCurrentUserMail & rs("CurrentUserMail") & ","
If aProjectLeaderMail <> aProductionPlannerMail Then
scc = scc & aProjectLeaderMail & "," & aProductionPlannerMail & ","
Else
scc = scc & "," & aProjectLeaderMail & "," 'Vlad: you had this here but also below: & aCurrentUserMail & ","
End If
If aCurrentUserMail <> aProductionPlannerMail And aCurrentUserMail <> aProjectLeaderMail Then
scc = scc & "," & aCurrentUserMail & ","
End If
'Vlad:add MaterialPlannerMail
If InStr(scc, aMaterialPlannerMail) = 0 Then scc = scc & "," & aMaterialPlannerMail & ","
rs.MoveNext
Loop
vSubject = "New DAW Sheet Listing - Registration: " & " " & DLookup("[Registration]", "[EmailTblQry_NewDaw]") & " " & ", DAW Sheet" & " " & SimpleCSV("Select DawNoSeq FROM EmailTBLQry_NewDaw_Sequence_Sum;")
SimpleCSV ("Select DawNoSeq FROM EmailTBLQry_NewDaw_Sequence_Sum;")
vReportPDF = CurrentProject.Path & "\" & "DAW Sheet.pdf"
'<<<<<<<<<<<<<<<<<<<<export the report as PDF>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
DoCmd.OutputTo acReport, "DAW Sheet", acFormatPDF, vReportPDF
'<<<<<<<<<<<<<<<<<<<<export the report as PDF>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'<<<<<<<<<<<<<<<<<<call Colin's sub to email reportio as attachment>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'SendEMailCDO vRecipientList, scc, vSubject, vMsg, "", vReportPDF 'Vlad:you get the From in this sub in vRecipientListFrom variable so use it
SendEMailCDO vRecipientList, scc, vSubject, vMsg, vRecipientListFrom, vReportPDF
'<<<<<<<<<<<<<<<<<<call Colin's sub to email report as attachment>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'Vlad:cleanup recordset
rs.Close
Set rs = Nothing
DoCmd.SetWarnings False
DoCmd.RunMacro "New DAW Email List"
DoCmd.Close acForm, "New DAW Sheet - Create Listing"
DoCmd.SetWarnings True
DoCmd.Hourglass False
'MsgBox ("Report successfully eMailed!")
'Debug.Print aProjectLeaderMail, aProductionPlannerMail, aCurrentUserMail, aMaterialPlannerMail
'Debug.Print sCC
'Debug.Print vRecipientList
'Debug.Print vRecipientListFrom
'Debug.Print aCurrentUserMail
'Debug.Print DAWNo
'Else
'MsgBox "No contacts."
'End If
End Sub