Hi,
I have that code in my Execute
It send mail, I need Production Planner, Project leader and Current user mail (If not the same as production planner)
Outlook to Gsuite
- Thread starter Gismo
- Start date
I have that code in my Execute
It send mail, I need Production Planner, Project leader and Current user mail (If not the same as production planner)
bastanu
AWF VIP
- Local time
- Yesterday, 22:30
- Joined
- Apr 13, 2010
- Messages
- 1,406
Try this:
Note that manipulation of the sCC string should be done in the first sub (Excecute_Click) and passed as the aCC( second argument) of the SendEmailCDO sub.
Cheers,
Code:
Option Explicit
Dim strFilename As String, strMsg As String
Private Sub Excecute_Click()
Dim SQL As String
Dim WPassStr As String
Dim sSQL As String
Dim aProjectLeaderMail As String
Dim aProductionPlannerMail As String
Dim aCurrentUserMail As String
DIm sCC as string
'Enter Password
If Nz(DLookup("[WPass]", "[GMailSettingsQry]")) = "" Then
Dim Message, Title, Default
Message = "Enter Windows Password"
Title = "Enter Parameters"
WPassStr = InputBox(Message, Title)
DoCmd.SetWarnings False
DoCmd.RunSQL "UPDATE GMailSettingsQry SET WPass =""" & WPassStr & """"
DoCmd.SetWarnings True
End If
Dim rs As Recordset
Dim vRecipientList As String
Dim vRecipientListCC As String
Dim vMsg As String
Dim vSubject As String
Dim vReportPDF As String
'aProjectLeaderMail = ProjectLeaderMail 'these line do nothing good
'aProductionPlannerMail = ProductionPlannerMail '
Set rs = CurrentDb.OpenRecordset("SELECT * FROM EmailTBLQry_NewDaw; ")
If rs.RecordCount > 0 Then
rs.MoveFirst
Do
'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!CurrentUserMail ) AND rs!CurrentUserMail <> "N/A" Then aCurrentUserMail = aCurrentUserMail & rs("CurrentUserMail ") & ","
'It send mail, I need Production Planner, Project leader and Current user mail (If not the same as production planner)
If aProjectLeaderMail <> aProductionPlannerMail Then
sCC=sCC & aProjectLeaderMail & "," & aProductionPlannerMail & ","
If aCurrentUserMail <> aProductionPlannerMail AND aCurrentUserMail <> aProjectLeaderMail Then
sCC=sCC & "," & aCurrentUserMail & ","
End If
Else
sCC=sCC & aProjectLeaderMail & ","
If aCurrentUserMail <> aProductionPlannerMail Then
sCC=sCC & "," & aCurrentUserMail & ","
End If
End if
rs.MoveNext
End If
Loop Until rs.EOF
vSubject = "New DAW Sheet Listing - Registration: " & " " & rs("Registration") 'you already have the recordset open this is faster
'vSubject = "New DAW Sheet Listing - Registration: " & " " & DLookup("[Registration]", "[EmailTblQry_NewDaw]")
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 report as attachment>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
SendEMailCDO vRecipientList, sCC, vSubject, vMsg, aCurrentUserMail , vReportPDF 'notice the vMsg is empty looks like you removed from the table
'<<<<<<<<<<<<<<<<<<call Colin's sub to email report as attachment>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'MsgBox ("Report successfully eMailed!")
'Debug.Print aProjectLeaderMail, aProductionPlannerMail, aCurrentUserMail
'Debug.Print Acc
Else
MsgBox "No contacts."
End If
End If
'DoCmd.RunMacro "New DAW Email List"
End Sub
Public Function GetUserName() As String
GetUserName = Environ("UserName")
End Function
Sub SendEMailCDO(aTo, Acc, aSubject, aTextBody, aFrom, aPath)
Dim rs As Recordset
'aFrom = CurrentUserMail 'again you cannot do this, you need to use a recordset or dlookups
'aCurrentUserMail = CurrentUserMail'see above
'==========================================
'Original code by Jeff Blumson
'Adapted by Colin Riddington to include file attachments
'Date: 25/08/2007
'==========================================
'Dim CDOEmailType As String
Dim txtSendUsing As String
Dim txtPort As String
Dim txtServer As String
Dim txtAuthenticate As String
Dim intTimeOut As String
Dim txtSSL As String
Dim txtusername As String
Dim txtPassword As String
Dim VWPass As String
Dim txtFrom As String
'Debug lines
'Debug.Print txtSendUsing, txtPort, txtServer, txtAuthenticate, intTimeOut, txtSSL
'Debug.Print txtusername, txtPassword, VWPass
'Debug.Print aTo, aProjectLeaderMail, aProductionPlannerMail, aCurrentUserMail
'Debug.Print aTo, aCC, aFrom
'Debug.Print aSubject
'Debug.Print aTextBody
'Debug.Print aPath
Set rs = CurrentDb.OpenRecordset("SELECT * FROM GMailSettingsQry;")
VWPass = VWPass & rs!WPass
'CDOEmailType = rs!EmailType
txtSendUsing = rs!SendUsing
txtPort = rs!ServerPort
txtServer = rs!EmailServer
txtAuthenticate = rs!SMTPAuthenticate
intTimeOut = rs!Timeout
txtusername = GetUserName
txtPassword = VWPass
txtSSL = rs!UseSSL
On Error GoTo err_SendEMailCDO
Const CdoBodyFormatText = 1
Const CdoBodyFormatHTML = 0
Const CdoMailFormatMime = 0
Const CdoMailFormatText = 1
Dim Message As Object
'Create CDO message object
Set Message = CreateObject("cdo.Message")
With Message.Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = txtSendUsing
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = txtPort
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = txtServer
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = txtAuthenticate
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = txtusername
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = txtPassword
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = intTimeOut
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = txtSSL
'code for STARTTLS
If txtPort = 587 Then
.Item("http://schemas.microsoft.com/cdo/configuration/sendtls").Value = True
End If
.Update
End With
DoCmd.Hourglass True
With Message
.To = aTo 'Set email adress why do you loop through the table if you don;t use the vRecipients????
'.To = aCurrentUserMail
.Subject = aSubject 'Set subject
.TextBody = aTextBody 'Set body text
If Len(Acc) > 0 Then .CC = Acc 'Set copy to
If Len(aFrom) > 0 Then .From = aFrom 'Set sender address if specified.
If Len(aPath) > 0 Then .AddAttachment (aPath) 'Attach this file
.Send 'Send the message
End With
Debug.Print Acc
'Debug.Print aTo, Acc, aFrom
'Debug.Print Acc & aProjectLeaderMail & aCurrentUserMail & aProductionPlannerMail
DoCmd.Hourglass False
'Show message
MsgBox "The email message has been sent successfully. ", vbInformation, "EMail message"
'Clean up
Set Message = Nothing
Exit_SendEMailCDO:
Exit Sub
err_SendEMailCDO:
'MsgBox "Error # " & str(err.Number) & Chr(13) & err.Description
strMsg = "Sorry - I was unable to send the email message(s). " & vbNewLine & vbNewLine & _
"Error # " & Str(Err.Number) & Chr(13) & Err.Description
MsgBox strMsg, vbCritical, "EMail message"
strMsg = ""
Resume Exit_SendEMailCDO
End SubCheers,
Thank you very much
Looks and works amazingly well
All I will add now is a masked password when the user enters his/her password, not to have the password entered in the inputbox visible
bastanu
AWF VIP
- Local time
- Yesterday, 22:30
- Joined
- Apr 13, 2010
- Messages
- 1,406
Here is a database that contains a module that gives you a replacement for the built-in input box with a password mask. Simply import the module into your db and replace
Cheers,
Vlad
WPassStr = InputBox(Message, Title) with WPassStr = InputBoxDK(Message, Title)Cheers,
Vlad
Hi, Yes I did
bastanu
AWF VIP
- Local time
- Yesterday, 22:30
- Joined
- Apr 13, 2010
- Messages
- 1,406
Please show me the full code again, it should work if you imported the module. Did you compile the project? What line do you get that error on?
EDIT: what happens in the sample I've sent you if you run Query1? Open the module and compile, do you get an error?
EDIT: what happens in the sample I've sent you if you run Query1? Open the module and compile, do you get an error?
Gasman
Enthusiastic Amateur
- Local time
- Today, 06:30
- Joined
- Sep 21, 2011
- Messages
- 15,708
That will likely be as you have NOT defined your variables correctly? none of your Dimmed variables are declared as strings, PLUS you MUST define everyone separately as string.
I Had it defined but received other errors so I removed it again as the sample DB did not have InputBoxDK defined, but then it ran from a query and not VB
When I define InputBoxDK, i get a Expected array error
Gasman
Enthusiastic Amateur
- Local time
- Today, 06:30
- Joined
- Sep 21, 2011
- Messages
- 15,708
You are NOT learning anything here. 
Vlad gave you a function in that module
so you do not define function names as strings?
I was referring to your code that Dims Message, Title and Default (I would have thought, that would be a reserved name as well?)
I cannot copy the code as you pasted it as a picture and not actual code
Vlad is likely asleep ATM, which is the only reason I am chipping in.
YOU have to define EACH variable as a type suitable for what you are going to use it for and how it is expected to be received.?
In this case Vlad set the function to expect the parameters to InputBoxDK as strings as see by the statement above.
As you have not bothered to say what your variables above are meant to be, they are defined by default as variants.?
So try
I am still not sure about that Default word, so google for Access reserved names and check.
HTH
Vlad gave you a function in that module
Code:
Public Function InputBoxDK(Prompt As String, Optional Title As String, _so you do not define function names as strings?
I was referring to your code that Dims Message, Title and Default (I would have thought, that would be a reserved name as well?)
I cannot copy the code as you pasted it as a picture and not actual code
Vlad is likely asleep ATM, which is the only reason I am chipping in.
YOU have to define EACH variable as a type suitable for what you are going to use it for and how it is expected to be received.?
In this case Vlad set the function to expect the parameters to InputBoxDK as strings as see by the statement above.
As you have not bothered to say what your variables above are meant to be, they are defined by default as variants.?
So try
Code:
Dim Message AS String, Title AS String, Default AS StringI am still not sure about that Default word, so google for Access reserved names and check.
HTH
Gasman, I understand what you are saying.You are NOT learning anything here.
Vlad gave you a function in that module
Code:Public Function InputBoxDK(Prompt As String, Optional Title As String, _
so you do not define function names as strings?
I was referring to your code that Dims Message, Title and Default (I would have thought, that would be a reserved name as well?)
I cannot copy the code as you pasted it as a picture and not actual code
Vlad is likely asleep ATM, which is the only reason I am chipping in.
YOU have to define EACH variable as a type suitable for what you are going to use it for and how it is expected to be received.?
In this case Vlad set the function to expect the parameters to InputBoxDK as strings as see by the statement above.
As you have not bothered to say what your variables above are meant to be, they are defined by default as variants.?
So try
Code:Dim Message AS String, Title AS String, Default AS String
I am still not sure about that Default word, so google for Access reserved names and check.
HTH
My question is,
Message and Title is not defined, and the code is as what was advised to used before I changed to masked password, and the code worked fine
now I am adding "DK" to the code, then I get the error on "Message"
that is what is confusing me
In the modInput module I do have the the code as above mentioned
I copied the code as Vlad advised and only changed InputBox to InputBoxDK, also as advise.
And in my code, I do have Message, Title and Default defined, see the below and screenshot you are referring to
Gasman
Enthusiastic Amateur
- Local time
- Today, 06:30
- Joined
- Sep 21, 2011
- Messages
- 15,708
What have I just said?
The only variable that is actually defined as a string in the Dim aTo statement is strMsg from that statement. So I would say you do NOT understand what I am saying.?
Define them like below, though you can put them on the same line
I have to go out now, and you will need to wait for someone else to chip in or Vlad to wake up.
The only variable that is actually defined as a string in the Dim aTo statement is strMsg from that statement.
So I would say you do NOT understand what I am saying.?Define them like below, though you can put them on the same line
Code:
Dim SQL As String
Dim WPassStr As String
Dim sSQL As String
Dim InputBoxDK As String ' Get rid of this line.!!!!!I have to go out now, and you will need to wait for someone else to chip in or Vlad to wake up.
bastanu
AWF VIP
- Local time
- Yesterday, 22:30
- Joined
- Apr 13, 2010
- Messages
- 1,406
@Gizmo,
Gasman gave you the answer twice:
You have:
The InOutBoxDK function declared in the module expects strings but you provide variants.
So:
should work but as Gasman pointed out you need to remove the line where you declare the function as string in your sub (as it is already declared in the module you imported from the sample).
Gasman gave you the answer twice:
You have:
Code:
'Enter Password
If Nz(DLookup("[WPass]", "[EmailTbl]")) = "" Then
Dim Message, Title, DefaultSo:
Code:
'Enter Password
If Nz(DLookup("[WPass]", "[EmailTbl]")) = "" Then
Dim Message AS STRING, Title AS STRING, Default AS STRING
Last edited:
Thank you
it did, thank you
my problem is, as i go along, i change my requirement then things go wrong and wont work
I just could not understand why all was well with Dim Message, Title, Default but when I changed to InputboxDK I had to change to Dim Message AS STRING, Title AS STRING, Default AS STRING
I thing thaw as throwing me off a bit
but i just added code and seems to work ok
Gasman
Enthusiastic Amateur
- Local time
- Today, 06:30
- Joined
- Sep 21, 2011
- Messages
- 15,708
For the most part, it I suspect it would not matter much in a lot of circumstances, but it is being very lazy, in my opinion.? Variants can handle Nulls, but I personally have hardly ever used them, but they will be there for a purpose.
ALWAYS define your variables for EACH TYPE! I tend to group strings together, integers, longs etc when I Dim any variable.
Because Vlads function expected strings, that is what you need to supply, no other type.
Also you do not seem to be aware of the difference between a function and a string, just naming stuff adhoc.?
Never have anything named EXACTLY the same.
How is Access (or anyone for that matter) meant to know which you are referring to.?If you are going to start changing code supplied to you, YOU have to understand how it works. This is why I prefer to prod people into thinking for themselves and then hopefully the knowledge will stick. Too many times, I see a solution supplied, and then the person comes back and states 'Now I want to do this' or 'It doesn't work (because they have not even changed the names to suit
). They do not appear to want to think for themselves, and that hurts no one but themselves. If you want to play at coding, start learning. We are on 120 posts in this thread for a minor problem. Not the initial query, but simple code to support it.
There is no easy way around that, believe me I know. 
