MS Access send email (not from outlook or user's email) - ms-access

I know this question has been asked a few times in various context, but I have not found a clear answer. I have email implemented for an access application using outlook, but I'd like to move away from this. One of the purposes of the email is to email a user his/or password if he forgot it. They can select their username for the login screen, and if they click 'forgot password' and email is sent containing their login information (to the email address associated with the user name).
The problem with this is that the email function as is sends an email with outlook from the user's machine. So, users would be able to 'forgot password' other usernames and view their own outlook outbox(sent items) to see the sensitive information.
Is there a way to e-mail like php's mail function, sending mail from the server? I would like the emails to be sent from the same email address i.e(support#company.com), instead of from the user's outlook address after a security prompt. If this is not possible, I am open to the idea of any other workarounds.
I will also add that installing any software that would have to be installed on every potential user's machine is not feasible.
Is this possible?

Windows includes an object called Collaborative Data Objects or CDO. This object allows you to send emails using any SMTP server assuming that other prerequisites are met (firewall open, ISP not blocking ports, account is configured on the SMTP server, SMTP server allows relaying, etc).
Most of the examples I've found use late binding, which is preferred. In my testing on XP it appeared that the correct library reference, if you prefer to use early binding, is "Microsoft CDO for Windows 2000 Library".
It's important to know that any time you send email you will have to send it through (or out of) some kind of email server. This means you will have to authenticate with that email server and also usually means that you need to send the email out using a "From" email address that exists on that very email server.
Here's some code using late binding:
Const cdoSendUsingPickup = 1
Const cdoSendUsingPort = 2
Const cdoAnonymous = 0
' Use basic (clear-text) authentication.
Const cdoBasic = 1
' Use NTLM authentication
Const cdoNTLM = 2 'NTLM
Public Sub SendEmail()
Dim imsg As Object
Dim iconf As Object
Dim flds As Object
Dim schema As String
Set imsg = CreateObject("CDO.Message")
Set iconf = CreateObject("CDO.Configuration")
Set flds = iconf.Fields
' send one copy with SMTP server (with autentication)
schema = "http://schemas.microsoft.com/cdo/configuration/"
flds.Item(schema & "sendusing") = cdoSendUsingPort
flds.Item(schema & "smtpserver") = "mail.myserver.com"
flds.Item(schema & "smtpserverport") = 25
flds.Item(schema & "smtpauthenticate") = cdoBasic
flds.Item(schema & "sendusername") = "email#email.com"
flds.Item(schema & "sendpassword") = "password"
flds.Item(schema & "smtpusessl") = False
flds.Update
With imsg
.To = "email#email.com"
.From = "email#email.com"
.Subject = "Test Send"
.HTMLBody = "Test"
'.Sender = "Sender"
'.Organization = "My Company"
'.ReplyTo = "address#mycompany.com"
Set .Configuration = iconf
.Send
End With
Set iconf = Nothing
Set imsg = Nothing
Set flds = Nothing
End Sub

This works for me in MS Access 2010 / Windows 7
sMailServer = "myISPsmtp" 'Not just any old smtp
sMailFromAddress = "me"
sMailToAddress = "me"
Set ObjMessage = CreateObject("CDO.Message")
sToAddress = sMailToAddress
sSubject = "Subject"
sBody = "MailBody"
ObjMessage.Subject = sSubject
ObjMessage.From = sMailFromAddress
ObjMessage.To = sToAddress
'ObjMessage.cc = sCCAddress
ObjMessage.TextBody = sBody
'ObjMessage.AddAttachment sMailAttachment
ObjMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
ObjMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = sMailServer
ObjMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
ObjMessage.Configuration.Fields.Update
ObjMessage.send
More info: http://msdn.microsoft.com/en-us/library/ms526318(v=exchg.10).aspx

I cannot add this to the comments because I do not have enough reputation, so please don't axe me.
"Seems like this method lets you spoof about anything on my server. Just noticed that there's an addAttachment method. Could that work with just a relative path to say, an excel sheet? "
It works for me (Access 2010, Exchange 2010):
.AddAttachment ("URL HERE")
https://msdn.microsoft.com/en-us/library/ms526453(v=exchg.10).aspx
https://msdn.microsoft.com/en-us/library/ms526983(v=exchg.10).aspx

The following MS-Access VBA code works for smtp.office365.com. You DO indicate smtpusessl=true, but you do NOT specify the port, otherwise you get error 5.7.57.
Sub SMPTTest2()
Set emailObj = CreateObject("CDO.Message")
emailObj.From = "name#myaddress.com"
emailObj.To = "name#youraddress.com"
emailObj.Subject = "Test CDO"
emailObj.TextBody = "Test CDO"
'emailObj.AddAttachment "c:\windows\win.ini"
Set emailConfig = emailObj.Configuration
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.office365.com"
'Exclude the following line
'emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 587
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = "name#myaddress.com"
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "mypassword"
emailConfig.Fields.Update
emailObj.Send
If Err.Number = 0 Then MsgBox "Done"
End Sub

At my company I used a other solution. I have created a C# Class Library with COM classes / objects. COM classes can be implemented in your Access application and this way you can use all the advantages of C# (Mailing for example) and still use it (calling it) in Access.
The only disadvantage is that you have to register your Class Library (DLL) at all the computers who use your access application. I have done that with a simple power-shell script which executes at the start of the Access application.
A good start for A COM based library is here: https://www.codeproject.com/Articles/7859/Building-COM-Objects-in-C
If you would like some more information about it then I am always happy to help you.

Related

Sending an e-mail via VBA with Outlook Exchange

So for many years I've been using CDO to send e-mails via POP and have had no issues. However, we are going to be upgrading to an Outlook Exchange e-mail server and POP is no longer available, it also requires TLS which I've read isn't supported by CDO.
This is what I have been doing:
Set cdoConfig = CreateObject("CDO.Configuration")
With cdoConfig.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "my smtpserver"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "email#email.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "mypassword"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Update
End With
Set objEmail = CreateObject("CDO.Message")
Set objEmail.Configuration = cdoConfig
This has always worked in the past. I tried updating the smtp server to smtp.office365.com and the port to 587 but I get the following error:
The server rejected the sender address. The server response was: 530 5.7.57 SMTP; Client was not authenticated to send anonymous mail during MAIL FROM [MWHPR08CA0030.namprd08.prod.outlook.com]
I'm currently using Access 2003, we will be upgrading to 2015 soon, but for now I need a solution that works in 2003.
Thanks.

ms access module to add attachment from button

I am having the following code in a module, which it is send email with attachment to user.
Public Sub EmailToUser()
Dim mail As Object ' CDO.MESSAGE
Dim config As Object ' CDO.Configuration
Set mail = CreateObject("CDO.Message")
Set config = CreateObject("CDO.Configuration")
config.Fields(cdoSendUsingMethod).Value = cdoSendUsingPort
config.Fields(cdoSMTPServer).Value = "my smtp server"
config.Fields(cdoSMTPServerPort).Value = 465
config.Fields(cdoSMTPConnectionTimeout).Value = 10
config.Fields(cdoSMTPUseSSL).Value = "true"
config.Fields(cdoSMTPAuthenticate).Value = cdoBasic
config.Fields(cdoSendUserName).Value = "e=mail"
config.Fields(cdoSendPassword).Value = "password"
config.Fields.Update
Set mail.Configuration = config
With mail
.To = "e-mail"
.From = "e-mail"
.Subject = "subject"
.AddAttachment strPathReport & FileName '<== My question.
.Send
End With
Set config = Nothing
Set mail = Nothing
End Sub
I have a form with 8buttons and each button is send an email with an attachment.
Now, I have in my module 8 times the same code with different attachment.
Is it possible to have only one time the above code and from the button to add the attachment?
Thank you.
Basically you want to add parameters to the procedure. And then pass in the e-mail address, etc. as arguments.
This question should give you some ideas on how to do that: multiple argument subs vba

Prompting Database Login When generating report from a listview contents to crystal reports

I got this code and getting an error prompt. Database Login. Even I put the right password, it always says Login Failed.
Dim report As New ReportDocument
report.Load("rptPrntIss.rpt")
report.RecordSelectionFormula = "{tbl_issued.TransactionID}=" & txtIssID.Text & "AND ({tbl_transaction.Department}=" & cBoxDpt.Text & ")"
frmPrnt.CrystalReportViewer1.ReportSource = report
frmPrnt.CrystalReportViewer1.Refresh()
frmPrnt.ShowDialog()
Maybe this code is not right, because everything was perfect without this code.
use setdatabaselogon() function to prevent prompting database logon each time.
it will be like
report.SetDatabaseLogon("username", "password", "server", "dbname", false)
in some cases this will also wont work(had some situations recently for me),in that case we need to specify database login for each tables in report.
like
dim connInfo as new ConnectionInfo()
connInfo.ServerName = yourserver
connInfo.DatabaseName = "dbname"
connInfo.UserID = "username"
connInfo.Password = "password"
dim tableLogOnInfo as new TableLogOnInfo()
tableLogOnInfo.ConnectionInfo = connInfo
foreach Table as table in reportDoc.Database.Tables
table.ApplyLogOnInfo(tableLogOnInfo)
table.LogOnInfo.ConnectionInfo.ServerName = connInfo.ServerName
table.LogOnInfo.ConnectionInfo.DatabaseName = connInfo.DatabaseName
table.LogOnInfo.ConnectionInfo.UserID = connInfo.UserID
table.LogOnInfo.ConnectionInfo.Password = connInfo.Password
next
hope this helps.

How can I get current Office Windows account email using VBA?

How can I get current Office Windows account email using VBA code?
I do not mean the account which the user is logged in the Windows, I mean the account that is authorized in office
See image:
I don't believe you can access it. Your best bet is linking Access to Outlook and trying to access it from there.
For example you Set a reference to the Outlook object library and then :-
Dim olook As Outlook.Application
Dim EAddress As String
Set olook = GetObject(, "Outlook.Application")
Set olook = CreateObject("Outlook.Application")
EAddress = olook.Session.CurrentUser.Address
I have a similar solution calling out to Outlook, I'm using Excel and found a way to do this, I've only ever found one address in the Accounts collection, but have a suffix match to try and catch the #company.com I'm looking for:
Dim NameSpace As Object
Dim strEmailAddress As String
Set NameSpace = CreateObject("Outlook.Application").GetNameSpace("MAPI")
strEmailAddress = ""
For Each Account In NameSpace.Accounts
If LCase(Split(Account.SMtpAddress, "#")(1)) = "contoso.com" Then
strEmailAddress = Account.SMtpAddress
Else
strEmailAddress = "Unknown"
End If
' If you want to see more values, uncomment these lines
'Debug.Print Account.DisplayName
'Debug.Print Account.UserName
'Debug.Print Account.SMtpAddress
'Debug.Print Account.AccountType
'Debug.Print Account.CurrentUser
Next
Outlook interrupts the VBA-execution (to access Outlook objects from macro) due to security.
Snap shot
Outlook Security
Hence only to get eMailID without opening object as well as handling error in case of non availability of outlook/account, following code can work in your case
VBA Code
Sub Email_Address()
Dim MAPI As Object
Status = "unknown"
On Error GoTo return_value
Set MAPI = CreateObject("Outlook.Application").GetNameSpace("MAPI")
i = 1
Do While True
Debug.Print MAPI.Accounts.Item(i)
i = i + 1
Loop
return_value:
If i > 1 Then: Status = "done..."
Debug.Print Status
End Sub

Send email from Access if DOB is within 'n' days

I needed to make it in access so that I send an email to a certain customer when their date of birth is within 3 days.
Dim rs as dao.recordset
set rs = currentdb.openrecordset(“DiscountEmail”)
with rs
if .eof and .bof then (No Records found for this query.)
Msgbox “ No emails will be sent because there are no records from the query ‘DiscountEmail’ “
else
do until .eof
DoCmd.SendObject acSendNoObject, , , ![Email Address Field], , , “Happy Birthday!”, “Hello ” & ![First Name Field] & _
“, ” & Chr(10) & “Come in on your birthday and receive a 10% discount!”, False
.edit
![Email_Sent_Date] = now()
.update
.movenext
loop
End If
end with
If Not rs Is Nothing Then
rs.Close
Set rs = Nothing
End If
I have this code, but now I just need to make it so that if a certain customer's birthday (In my table 'CustomerInfo') is within 3 days, it sends them an email saying that they can come in on their birthday and receive a discount.
Also, I want to make it so that this happens automatically (so I don't have to press any button), but so that it sends it only once, and so I can send it again next year.
Thanks in advance! :)
You need to have some event in order to fire this event. An Access database is just a file, so when you're not using it, it's not running any code.
Doing a simple check every time the database is opened, maybe on the first form's On Load event would be the way to go. I assume your DiscountEmail RecordSet is the one querying for emails within the 3 day period.
Your solution is to either put this in the onLoad event for your first form or to use another service. As far as not spamming the emailee more than once, just add a emailSent field or log sent emails to a different table, and handle it after the email is sent.
Example query to find the relevant emails:
Select email from Users Where dateOfBirth between dateAdd("d",-3,Date()) AND dateAdd("d",3,Date());
Do send an email, you could use SMTP and CDO. Create an email function called something like sendEmail
Public Sub SendEmail(strTo as STring, strFrom as String, strSubj as String, strBody as String)
Dim imsg As Object
Dim iconf As Object
Dim flds As Object
Dim schema As String
Set imsg = CreateObject("CDO.Message")
Set iconf = CreateObject("CDO.Configuration")
Set flds = iconf.Fields
' send one copy with SMTP server (with autentication)
schema = "http://schemas.microsoft.com/cdo/configuration/"
flds.Item(schema & "sendusing") = cdoSendUsingPort
flds.Item(schema & "smtpserver") = "mail.myserver.com" 'your info here
flds.Item(schema & "smtpserverport") = 25
flds.Item(schema & "smtpauthenticate") = cdoBasic
flds.Item(schema & "sendusername") = "email#email.com" 'more of your info
flds.Item(schema & "sendpassword") = "password"
flds.Item(schema & "smtpusessl") = False
flds.Update
With imsg
.To = strTo
.From = strFrom
.Subject = strSubj
.HTMLBody = strBody
'.body = strBody
'.Sender = "Sender"
'.Organization = "My Company"
'.ReplyTo = "address#mycompany.com"
Set .Configuration = iconf
.Send
End With
Set iconf = Nothing
Set imsg = Nothing
Set flds = Nothing
End Sub
You could either loop through the resultset of your query and call your sendmail function for each email, or write a quick helper function that fetches and concatenates your email fields into a ";" delimited list, and just send the email once with multiple recipients.
If the essence of your question is about the actual sending of the email message itself, then you may find that DoCmd.SendObject may not be the best method. It has several limitations, most significantly (ref: here)
the message text is limited to 255 characters
it depends on interaction with an email client application (via MAPI, I assume) so it may not work if there is no mail client configured, or if the mail client is not a Microsoft product
Instead, you might consider sending the messages via CDO. There is a good write-up and some ready-to-use VBA code here:
http://www.cpearson.com/excel/Email.aspx