Access Email server settings

[davedinger]

I have code Posted Below which worked great to send e-mail through Access as long as I hard coded in the Server and user parameters. IE server name / user name ect.

In need to make this so that if a different user or customer wants to use their email server they can change it easily.

I created a table named TblEmailSettings where through the use of a form I expect only one record ever to be entered. My plan is to just have one form where they can view and change the settings.

I've highlighted the fields below i'm talking about in Green, I think I'm just using the wrong syntax but i'm not sure
any help is great.

Thanks

- -- - - - - - - -
' send via E mail
'"Send reports Via Visual Basic E-Mail****"
Dim objCDOConfig As Object
Dim objCDOMessage As Object


Dim CurrentFolder As String


Dim FileName As String
Dim myPath As String
Dim UniqueName As Boolean


UniqueName = False


'setting smtp gmail mail
Const cdoschema = "http://schemas.microsoft.com/cdo/configuration/"
Const cdoSendUsingPort = 2
Const cdoBasic = 1
Const cstrServer = [TblEmailSettings]![ServerAddress]
Const cstrFrom = [TblEmailSettings]![EmailAccount]
Set objCDOConfig = CreateObject("CDO.Configuration")
With objCDOConfig.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = [TblEmailSettings]![EmailAccount]
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = [TblEmailSettings]![AccountPassword]
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = [TblEmailSettings]![ServerAddress]
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Update

End With
'setting smtp gmail complete
Set objCDOMessage = CreateObject("CDO.Message")
With objCDOMessage
Set .Configuration = objCDOConfig
.From = [TblEmailSettings]![EmailFrom]
.Sender = cstrFrom
.To = Forms![Customer Form Selector]![Primary E-mail]
.CC = [TblEmailSettings]![CCSender]
.Subject = [TblEmailSettings]![SubjectLine]
.TextBody = [TblEmailSettings]![Message]
.AddAttachment ("C:\Users\Dave\Documents\Daily Scan.pdf")
.Send
End With
'Kill FileName & "*.XLS"
Beep
MsgBox "E-mail Sent", vbInformation, ""




End Sub

[Gicu]

Replace with dLookups:
Const cstrServer =dlookup("[ServerAddress]","[TblEmailSettings]")

Cheers,

[davedinger]

Im not sure if I explained it right, I have a table that contains the server settings. I need the code to look at those server settings and use those fields to send the email. Will Dlookup do that?

This is the result of what you suggested

[Gicu]

Yes, it will, try to declare it as a Public Variable instead of a constant.And you have a few more places to add dLookup.
Cheers,

[davedinger]

Im sorry, but I'm not familiar with public variables vs constants. I did some online searches and it makes some sense to me and why it needs to be Public, and I found it has to do with the Dim Statement, but I also see where the Const statements in the current code and i think your saying those have to be changed? So I'm confused
I added the DLookups in the places i think the needed to be. Where do I go from here?.

Thanks for your help

New Code
- - - - - - - - - - - - - - -


Public Sub Command29_Click()
'******************************************
'******** Create PDF file and Email******
'******************************************


'Create File
DoCmd.OutputTo acOutputReport, "Daily Scan", "PDFFormat(*.pdf)", "", False, "", , acExportQualityPrint
Beep
MsgBox "File Created Now E-mailing", vbInformation, ""
DoCmd.Close acReport, "Daily Scan"

' send via E mail
'"Send reports Via Visual Basic E-Mail****"
Dim objCDOConfig As Object
Dim objCDOMessage As Object


Dim CurrentFolder As String
Dim FileName As String
Dim myPath As String
Dim UniqueName As Boolean


UniqueName = False


'setting smtp gmail mail


Const cdoschema = "http://schemas.microsoft.com/cdo/configuration/"
Const cdoSendUsingPort = 2
Const cdoBasic = 1
Const cstrServer = DLookup("[ServerAddress]", "[TblEmailSettings]")
Const cstrServer = DLookup("[EmailAccount]", "[TblEmailSettings]")
Set objCDOConfig = CreateObject("CDO.Configuration")
With objCDOConfig.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = DLookup("[EmailAccount]", "[TblEmailSettings]")
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = DLookup("[AccountPassword]", "[TblEmailSettings]")
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = DLookup("[ServerAddress]", "[TblEmailSettings]")
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Update

End With
'setting smtp gmail complete
Set objCDOMessage = CreateObject("CDO.Message")
With objCDOMessage
Set .Configuration = objCDOConfig
.From = [TblEmailSettings]![EmailFrom]
.Sender = cstrFrom
.To = Forms![Customer Form Selector]![Primary E-mail]
.CC = DLookup("[CCSender]", "[TblEmailSettings]")
.Subject = DLookup("[SubjectLine]", "[TblEmailSettings]")
.TextBody = DLookup("[Message]", "[TblEmailSettings]")
.AddAttachment ("C:\Users\Dave\Documents\Daily Scan.pdf")
.Send
End With
'Kill FileName & "*.XLS"
Beep
MsgBox "E-mail Sent", vbInformation, ""




End Sub


End Sub

[davegri]

You can't use brackets for the DLookups. The function will for example see "[TblEmailSettings]" instead of "TblEmailSettings" as the table name.

[Gicu]

Try this please:

Public Sub Command29_Click()
'******************************************
'******** Create PDF file and Email******
'******************************************


'Create File
DoCmd.OutputTo acOutputReport, "Daily Scan", "PDFFormat(*.pdf)", "", False, "", , acExportQualityPrint
Beep
MsgBox "File Created Now E-mailing", vbInformation, ""
DoCmd.Close acReport, "Daily Scan"

' send via E mail
'"Send reports Via Visual Basic E-Mail****"
Dim objCDOConfig As Object
Dim objCDOMessage As Object


Dim CurrentFolder As String
Dim FileName As String
Dim myPath As String
Dim UniqueName As Boolean


UniqueName = False


'setting smtp gmail mail


Const cdoschema = "http://schemas.microsoft.com/cdo/configuration/"
Const cdoSendUsingPort = 2
Const cdoBasic = 1
'Vlad commented out on March 29/2020
Public strSMTPServer = DLookup("[ServerAddress]", "[TblEmailSettings]") as string
Public strFrom = DLookup("[EmailAccount]", "[TblEmailSettings]") as string

Set objCDOConfig = CreateObject("CDO.Configuration")
With objCDOConfig.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTPServer 'DLookup("[ServerAddress]", "[TblEmailSettings]")
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = strFrom  'DLookup("[EmailAccount]", "[TblEmailSettings]")
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = DLookup("[AccountPassword]", "[TblEmailSettings]")
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Update

End With
'setting smtp gmail complete
Set objCDOMessage = CreateObject("CDO.Message")
With objCDOMessage
Set .Configuration = objCDOConfig
.From = strFrom 
.Sender = strFrom 
.To = Forms![Customer Form Selector]![Primary E-mail]
.CC = DLookup("[CCSender]", "[TblEmailSettings]")
.Subject = DLookup("[SubjectLine]", "[TblEmailSettings]")
.TextBody = DLookup("[Message]", "[TblEmailSettings]")
.AddAttachment ("C:\Users\Dave\Documents\Daily Scan.pdf")
.Send
End With
'Kill FileName & "*.XLS"
Beep
MsgBox "E-mail Sent", vbInformation, ""




End Sub


End Sub

@davegri
Yes, Dave, you can use square brackets in domain functions:

Cheers,
Vlad

[davegri]

Yes, Dave, you can use square brackets in domain functions:

Thanks for the clarification. I actually ran into this brackets problem a while back, but can't remember details now...

[davedinger]

This Obviously way over my head now, so thanks!
But Im getting a compiler Syntax error message on this line:

Public strSMTPServer = DLookup("[ServerAddress]", "[TblEmailSettings]") as string

It seems to have an issue with the =

By the way I created a different Control button to test the code on, it was 29 now its 30.

Im not sure if it helps but below is a clip of my table and then the Current code that should be the same thing you sent



- - - - - - - - - - -

Public Sub Command30_Click()

'******************************************
'******** Create PDF file and Email******
'******************************************


'Create File
DoCmd.OutputTo acOutputReport, "Daily Scan", "PDFFormat(*.pdf)", "", False, "", , acExportQualityPrint
Beep
MsgBox "File Created Now E-mailing", vbInformation, ""
DoCmd.Close acReport, "Daily Scan"


' send via E mail
'"Send reports Via Visual Basic E-Mail****"
Dim objCDOConfig As Object
Dim objCDOMessage As Object




Dim CurrentFolder As String
Dim FileName As String
Dim myPath As String
Dim UniqueName As Boolean




UniqueName = False




'setting smtp gmail mail




Const cdoschema = "http://schemas.microsoft.com/cdo/configuration/"
Const cdoSendUsingPort = 2
Const cdoBasic = 1
'Vlad commented out on March 29/2020
Public strSMTPServer = DLookup("[ServerAddress]", "[TblEmailSettings]") as string
Public strFrom = DLookup("[EmailAccount]", "[TblEmailSettings]") as string


Set objCDOConfig = CreateObject("CDO.Configuration")
With objCDOConfig.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTPServer 'DLookup("[ServerAddress]", "[TblEmailSettings]")
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = strFrom 'DLookup("[EmailAccount]", "[TblEmailSettings]")
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = DLookup("[AccountPassword]", "[TblEmailSettings]")
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Update


End With
'setting smtp gmail complete
Set objCDOMessage = CreateObject("CDO.Message")
With objCDOMessage
Set .Configuration = objCDOConfig
.From = strFrom
.Sender = strFrom
.To = Forms![Customer Form Selector]![Primary E-mail]
.CC = DLookup("[CCSender]", "[TblEmailSettings]")
.Subject = DLookup("[SubjectLine]", "[TblEmailSettings]")
.TextBody = DLookup("[Message]", "[TblEmailSettings]")
.AddAttachment ("C:\Users\Dave\Documents\Daily Scan.pdf")
.Send
End With
'Kill FileName & "*.XLS"
Beep
MsgBox "E-mail Sent", vbInformation, ""








End Sub

[kd2017]

Today I learned you can declare constants with in a sub! https://wellsr.com/vba/2019/excel/vb...-public-const/

Can you post the exact error message it's giving you?

[ssanfu]

No

Const cdoschema = "http://schemas.microsoft.com/cdo/configuration/"
Const cdoSendUsingPort = 2
Const cdoBasic = 1

'Vlad commented out on March 29/2020
Public strSMTPServer = DLookup("[ServerAddress]", "[TblEmailSettings]") as string
Public strFrom = DLookup("[EmailAccount]", "[TblEmailSettings]") as string

Variables declared within subroutine

Const cdoschema = "http://schemas.microsoft.com/cdo/configuration/"
Const cdoSendUsingPort = 2
Const cdoBasic = 1

'Vlad commented out on March 29/2020
Dim strSMTPServer as string
Dim strFrom as string

strSMTPServer = DLookup("[ServerAddress]", "[TblEmailSettings]")
strFrom = DLookup("[EmailAccount]", "[TblEmailSettings]")

Variables declared at MODULE Level

Option Compare Database
Option Explicit

Public strSMTPServer as string
Public strFrom as string


Private Sub btnMissing_Click()
   strSMTPServer = DLookup("[ServerAddress]", "[TblEmailSettings]")
   strFrom = DLookup("[EmailAccount]", "[TblEmailSettings]")
End Sub

---------------------------------------------------------------------------------
Syntax: DLookup(Expr, Domain, Criteria)

Also be aware (since you didn't specify any criteria)
The DLookup function returns a single field value based on the information specified in criteria. Although criteria is an optional argument, if you don't supply a value for criteria, the DLookup function returns a random value in the domain.

So if you have more than 1 record in the Domain (table/query) and no criteria, it is anybody's what value will be returned!

[Gicu]

Thanks Steve, of course you're right, I don't think it needs to be a public variable anyway or even a variable at all as I was trying to suggest with the commented out Dlookups, but of course Dim inside the sub should do it.

.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTPServer 'DLookup("[ServerAddress]", "[TblEmailSettings]")
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = strFrom 'DLookup("[EmailAccount]", "[TblEmailSettings]")

In the original post Dave(dinger) did mention that he expects tblEmailSettings to only have one record.

Sorry for the confusion!

Cheers,

[isladogs]

Just noticed this thread.
If it helps I have an example CDO Email Tester app with a complete set of code you could use. See http://www.mendipdatasystems.co.uk/e...ter/4594365455
FWIW I don't use any DLookups for the settings.
The settings are entered and tested on a form and stored in a table.
The code works in both 32-bit and 64-bit and can be used with plain text or HTML email.

[davedinger]

Thanks for the Option Isladogs, but thats way out of my league, Im not even sure how to use it.
and thanks Ssanfu for your input, but Vlad is correct, there will only be one record in the table that will contain only the current relevant data.

Below is the Error that I'm getting now after the suggested code on post #7 from Vlad.
Thanks for all of your help on this..

[Gicu]

Hi Dave,
Sorry, I really need to pay more attention, here is how it should be (from Steve's post #11):
Dim strSMTPServer as string
Dim strFrom as string

strSMTPServer = DLookup("[ServerAddress]", "[TblEmailSettings]")
strFrom = DLookup("[EmailAccount]", "[TblEmailSettings]")