I currently have an excel file that produces client statements. I need to track who has run their statements.
Currently, whenever statements are produced I have a macro that send me an email with their user name. However people running on a Thin Client system they get a prompt;
'A program is trying to send an email message on your behalf...'
IS there some way I can get rid of this prompt and still send the email, or has anyone got any other ideas on how to track usage. I share the file through Share Point. So that might have some capabilities?
Thank you
If there is a location on your network that everyone has access to you can write a log file. Most likely a spot on the Sharepoint server.
Something like this called from the code that is currently sending out the email.
In you VBA IDE go to the tools menu and select references. Select "Microsoft scripting runtime"
Private Sub LogUsage()
Dim ts As TextStream
Dim fs As FileSystemObject
Dim strLogFile As String
strLogFile = "\\servername\sharename\log\Usage.txt"
'Check if the file exists, if it does, open it, if it doesn't create it
Set fs = New FileSystemObject
If fs.FileExists(strLogFile) = True Then
Set ts = fs.OpenTextFile(strLogFile, ForAppending)
Else
Set ts = fs.CreateTextFile(strLogFile, True, False)
End If
'Log your entry
ts.WriteLine "Used by " & Environ$("Username") & " at " & Now & " on computer " & Environ$("Computername")
'Clean up
ts.Close: Set ts = Nothing
Set fs = Nothing
End Sub
I'd use a shared database, like SQL server or Access on a network share, rather than an e-mail. It's easier to work with than separate e-mails.
If you must use e-mail, you can use a CDO object in your Excel macro, but your users must have access to an SMTP server on your network (usually an Exchange server works for this; look at your Outlook settings and see what server it's connected to). Generally this is not a problem if everyone has access to the same LAN resources.
Add a reference in the VBA editor to Microsoft CDO for Windows 2000 Library (Tools->References in VBA. Don't worry about the "Windows 2000"; it should be available on your system).
Example code
Dim iMsg As CDO.Message
Dim iConf As CDO.Configuration
Dim Flds As ADODB.Fields
Set iMsg = New CDO.Message
Set iConf = New CDO.Configuration
Set Flds = iConf.Fields
With Flds
.Item(cdoSendUsingMethod) = cdoSendUsingPort
'Put the address of your SMTP server here
.Item(cdoSMTPServer) = "smtp.example.com"
.Item(cdoSMTPConnectionTimeout) = 10
.Item(cdoSMTPAuthenticate) = cdoBasic
.Item(cdoSendUserName) = "Username To Authenticate SMTP Server With"
.Item(cdoSendPassword) = "Password To Authenticate SMTP Server With"
.Item(cdoURLGetLatestVersion) = True
.Update
End With
With iMsg
Set .Configuration = iConf
.From = "from#example.com"
.ReplyTo = "replyto#example.com"
.MimeFormatted = False
.AutoGenerateTextBody = False
.To = "to#example.com"
.CC = "cc#example.com"
.BCC = "bcc#example.com"
.Subject = "Subject of Email"
.HTMLBody = "<body>HTML text to send</body>"
'If you need to add attachments
.AddAttachment "C:\Local\Path\To\Attachment.xlsx"
.Send
End With
Related
when CDO.message (SMTP server) VBA code is run it checks if that gmail ID (from which we are sending email) is linked with the current system or not. If it is run on a new system where we never logged in with that gmail id then it gives sever failing error and email is not sent. So I want ask some other way with code (may be gmail api) which does not check for system's link with gmail ID.
BELOW IS THE CODE THAT I AM USING
Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant
Dim email As String
Dim pass As String
Dim CN As String
Dim OS As String
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = FF
.Item("http://schemas.microsoft.com/cdo/configuration/smtpaccountname") = "abcd"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = DD
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Update
End With
With iMsg
Set .Configuration = iConf
.To = FF
.CC = ""
.BCC = ""
.From = """from"" <Reply#something.nl>"
.Subject = UN & " C1 LOGGED IN"
.TextBody = "COMPUTER NAME IS -" & CPN & ", USERNAME NAME IS -" & UN & ", COMPUTER ID IS -" & sAns
.Send
End With
Set iMsg = Nothing
Set iConf = Nothing
Set Flds = Nothing
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Solution
Apps Script allows you to get information from Spreadsheets and other Google Documents and be able to use it to then send emails using its Gmail services under certain conditions met on these Spreadsheets for instance.
The following example is a simplification of your scenario where if two numbers / values do not match then you send an email to notify that the system has been run with another device. Below is the code with self-explanatory comments and an image representing the Spreadsheet I am using for this example.
function myFunction() {
// Get the sheet we will be using
var ss = SpreadsheetApp.getActive().getSheetByName('Sheet1');
// get the values of the range that contains the content
// flat is used to get the 2D array returned by getValues() into a simple
// 1D array with these values
var content = ss.getRange('A1:A3').getValues().flat();
// get the values of the range that contains the condition
var condition1 = ss.getRange('B1:B3').getValues().flat();
var condition2 = ss.getRange('C1:C3').getValues().flat();
// get the values of the range that contains the email address
var email = ss.getRange('D1:D3').getValues().flat();
// iterate over all the values of the content column
for(i=0;i<content.length;i++){
// if the column B and C have different values in the row
if(condition1[i]!=condition2[i]){
// send emails with the appropiate properties
GmailApp.sendEmail(email[i], 'Generated email', content[i]);
}
}
}
Resources used: Gmail App and SpreadsheetApp
I hope this has helped you. Let me know if you need anything else or if you did not understood something. :)
I am working with an Access application within Access 2016. The application outputs to a PDF file via the DoCmd.OutputTo method.
I want to either send this PDF attached to an email I build in code, or open a new Outlook email with the file attached.
When I click the button in the form which triggers the code that includes my sub(s) (which are located in separate modules), the email window is never displayed nor is an email sent (depending on the use of .Display vs .Send). I also do not receive any errors.
I think it may also be worth noting that the Call to the sub inside of a module that creates the PDF works as expected.
I am running Access 2016 and Outlook 2016 installed as part of Office 2016 Pro Plus on a Windows 7 64-bit machine. The Office suite is 32-bit.
The Module & Sub
(Email Address Redacted)
Dim objEmail As Outlook.MailItem
Dim objApp As Outlook.Application
Set objApp = CreateObject("Outlook.Application")
Set objEmail = oApp.CreateItem(olMailItem)
With objEmail
.Recipients.Add "email#domain.com"
.Subject = "Invoice"
.Body = "See Attached"
.Attachments.Add DestFile
.Display
End With
The Sub Call
MsgBox "Now saving the Invoice as a PDF"
strInvoiceNbr = Int(InvoiceNbr)
strWhere = "[InvoiceNbr]=" & Me!InvoiceNbr
strDocName = "Invoice Print One"
ScrFile = "Invoice Print One"
DestFile = "Inv" + strInvoiceNbr + " - " + Me.GetLastname + " - " + GetLocation
MsgBox DestFile, vbOKOnly
DoCmd.OpenForm strDocName, , , strWhere
Call ExportToPDF(SrcFile, DestFile, "INV")
Call EmailInvoice(DestFile)
Based on the fact that the PDF is being output within a sub in a Module file, should I be creating the email (or calling the sub) within the sub that creates the PDF?
NOTE: I have looked over this accepted answer here on Stack Overflow, as well as many others. My question differs due to the fact that I am asking why the message is not being displayed or sent, not how to build and send a message as the others are.
EDIT:
Outlook does not open and nothing occurs if Outlook is already open.
Final Note:
To add to the accepted answer, in the VBA editor for Access, you will likely have to go to Tools > References and enable Microsoft Outlook 16.0 Object Library or similar based on your version of Office/Outlook.
To pass full path try using Function EmailInvoice
Example
Option Explicit
#Const LateBind = True
Const olFolderInbox As Long = 6
Public Sub ExportToPDF( _
ByVal strSrcFileName As String, _
ByVal strNewFileName As String, _
ByVal strReportType As String _
)
Dim PathFile As String
Dim strEstFolder As String
strEstFolder = "c:\OneDrive\Estimates\"
Dim strInvFolder As String
strInvFolder = "c:\OneDrive\Invoices\"
' Export to Estimates or Invoices Folder based on passed parameter
If strReportType = "EST" Then
DoCmd.OutputTo acOutputForm, strSrcFileName, acFormatPDF, _
strEstFolder & strNewFileName & ".pdf", False, ""
PathFile = strEstFolder & strNewFileName & ".pdf"
ElseIf strReportType = "INV" Then
DoCmd.OutputTo acOutputForm, strSrcFileName, acFormatPDF, _
strInvFolder & strNewFileName & ".pdf", False, ""
PathFile = strEstFolder & strNewFileName & ".pdf"
End If
EmailInvoice PathFile ' call function
End Sub
Public Function EmailInvoice(FldrFilePath As String)
Dim objApp As Object
Set objApp = CreateObject("Outlook.Application")
Dim objNS As Object
Set objNS = olApp.GetNamespace("MAPI")
Dim olFolder As Object
Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
'Open inbox to prevent errors with security prompts
olFolder.Display
Dim objEmail As Outlook.MailItem
Set objEmail = oApp.CreateItem(olMailItem)
With objEmail
.Recipients.Add "email#domain.com"
.Subject = "Invoice"
.Body = "See Attached"
.Attachments.Add FldrFilePath
.Display
End With
End Function
Your issue is with probably Outlook security. Normally Outlook would show a popup that says that a 3rd party application is attempting to send email through it. Would you like to allow it or not. However since you are doing this programmatically that popup never appears. There used to be a way to bypass this.
Test your program while the user is logged on and has Outlook open. See if there will be any difference in behavior. If that popup does come up, google the exact message and you will probably find a way to bypass it.
Any reason why you not using sendOject?
The advantage of sendobject, is that you not restriced to Outlook, and any email client should work.
So, this code can be used:
Dim strTo As String
Dim strMessage As String
Dim strSubject As String
strTo = "abc#abc.com;def#def.com"
strSubject = "Your invoice"
strMessage = "Please find the invoice attached"
DoCmd.SendObject acSendReport, "rptInvoice", acFormatPDF, _
strTo, , , strSubject, strMessage
Note that if you need to filter the report, then open it first before you run send object. And of course you close the report after (only required if you had to filter, and open the report before - if no filter is to be supplied, then above code will suffice without having to open the report first).
There is no need to separate write out the pdf file, and no need to write code to attach the resulting pdf. The above does everything in one step, and is effectively one line of code.
We currently have an email automatically created by Excel using VBA, with subject, recipient, message body with template text all filled in.
Sub CreateMail(Optional sFile As String = "")
'Create email to send to requestor with attachment sFile
'Declarations
Dim app As Outlook.Application
Dim msg As Outlook.MailItem
Dim send_to As Recipient
Dim send_tos As Recipients
'Initiations
Set app = CreateObject("Outlook.Application")
Set msg = app.CreateItem(olMailItem)
Set send_tos = msg.Recipients
Set send_to = send_tos.Add("receiver#email.com")
send_to.Type = 1
'Create message
With msg
.SentOnBehalfOfName = "sender#email.com"
.Subject = "This is the email subject"
.HTMLBody = "This is the email body" & vbCrLf
'Resolve each Recipient's name.
For Each send_to In msg.Recipients
send_to.Resolve
Next
If Len(sFile) > 0 Then
.Attachments.Add sFile
End If
.Display
End With
End sub
After making some manual changes to the email that is created, we'd like to send it and have a copy saved to a folder on the file system automatically (in addition to the usual sent folder in Outlook). Is there a way to do this all within Excel VBA?
I suspect it might be possible using Outlook VBA, however the folders are defined in Excel and we'd like to keep the code together in the one file.
What is your code for sending email? This works for me in an Excel VBA module:
Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
With MailOutLook
.BodyFormat = olFormatRichText
.To = "email address"
.Subject = "Test"
.HTMLBody = "Test " & Now
.DeleteAfterSubmit = True 'to not retain in sent folder
.Display
.SaveAs "C:\filepath\Test.txt", 0
' .Send
End With
However, guess the real trick is allowing edit of the email before saving file. So far not seeing solution for that. Unfortunately the code execution does not pause while the message window is open. I was hoping for the pause since Office is supposed to be an integrated suite of apps - like opening a form in Access in dialog mode which does pause execution of code.
With code in Excel only, monitor the SentItems folder.
Utilizing Outlook Events From Excel
Confirm the mail from a unique ID.
The unique ID could be in the subject or body.
You could try saving the unique ID in PR_SEARCH_KEY. It is the same idea How, can get the exact sent Email from Sent Items folder? and How to uniquely identify an Outlook email as MailItem.EntryID changes when email is moved
I'm trying to automate the sending of an email through Lotus Notes 9.0 using VBA. The code will load up notes, which asks for my password but before the password prompt shows up, I get an error. The error I run in to is "Run-time error '-2147417851 (80010105)': Automation Error The server threw an exception" When I hit debug, the line that it fails on is "Set obDoc = obDB.CreateDocument". A lot of what I've seen online example wise matches what I'm doing in my code, so I'm not sure where the problem is.
Here's the code:
Sub Send_Emails()
Dim stSubject As Variant
Dim emailList As Variant
Dim obSess As Object
Dim obDB As Object
Dim obDoc As Object
'----Create Email List - separate function, dynamically creates email list based off report processing done in other functions
CreateEmailList
'----Info for Subject
stSubject = "test subject"
'----Create Notes Session
Set obSess = CreateObject("Notes.NotesSession")
Set obDB = obSess.GETDATABASE("", "")
If obDB.IsOpen = False Then
Call obDB.OPENMAIL
End If
'----Create the e-mail - **FAILURE OCCURS HERE**
Set obDoc = obDB.CreateDocument
'----Add values to the email
With obDoc
.form = "Memo"
.SendTo = "test#test.com"
.blindcopyTo = emailList
.Subject = stSubject
.HTMLBody = "<HTML><BODY><p>test</p></BODY></HTML>"
.SaveMessageOnSend = True
.PostedDate = Now()
.Send 0, emailList
End With
'----Clean Up
Set obDoc = Nothing
Set obDB = Nothing
Set obSess = Nothing
MsgBox "The e-mail has been sent successfully", vbInformation
End Sub
You mention that you are using Notes 9, so I looked at the online help for Notes 9.01 and the help page for the OpenMail method says
Note: This method is supported in LotusScript® only. For COM, use OpenMailDatabase in NotesDbDirectory.
Now, you're actually using the OLE automation classes (rooted at Notes.NotesSession), not the COM classes (rooted at Lotus.NotesSession), so I don't know if you can use the NotesDbDirectory class or not, but the other way of opening the current user's mail database would be to call NotesSession.GetEnvironmentString("MailServer",true) and NotesSession.GetEnvironmentString("MailFile",true), and use those as the values for your call to GetDatabase.
Possible Duplicate:
Send e-mail through VBA
Send email from Excel in Exchange environment
I have this so far
Dim objOutl
Set objOutl = CreateObject("Outlook.Application")
Set objMailItem = objOutl.CreateItem(olMailItem)
objMailItem.Display
strEmailAddr = "me.me#you.com"
objMailItem.Recipients.Add strEmailAddr
objMailItem.Body = "Hi"
objMailItem.Attachments.Add "access.xml"
Set objMailItem = nothing
Set objOutl = nothing
It works! But only on computers that have Outlook. How can I get this to work with computers that have Windows Live?
Windows Live Mail (WLM) doesn't support automation via VBA, so it isn't as straightforward as with Outlook.
For other options, try typing [vba] e-mail in the search field. You'll get quite a few hits; here is a relevant sample: Hit, hit, hit. Some of these give you working code for sending mail using CDO. This is what I would do if I were you.
If you must use WLM, then have a look at this mail add-ins for Excel which does support WLM.
Otherwise you're stuck using VBA's SendMail method, which is very limited:
Can only send an Excel object such as a sheet, workbook, chart, range, etc.
Can't write text in the body of the e-mail
Can't use the CC or BCC fields
Can't attach files (other than the Excel object calling the method)
Example code:
Dim wb As Workbook
Set wb = ActiveWorkbook
wb.SendMail "me.me#you.com", _
"Insert subject here"
For more examples look here: http://www.rondebruin.nl/sendmail.htm
the following suppose to work on access (vba) (code is not mine):
Public Function send_email()
Set cdomsg = CreateObject("CDO.message")
With cdomsg.Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'NTLM method
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 587
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "mygmail#gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "mypassword"
.Update
End With
' build email parts With cdomsg
.To = "somebody#somedomain.com"
.From = "mygmail#gmail.com"
.Subject = "the email subject"
.TextBody = "the full message body goes here. you may want to create a variable to hold the text"
.Send
End With
Set cdomsg = Nothing
End Function
note if you want to use other email service you should alter the code a bit.
some other options here - msdn reference
Hope it helps.