I have an Excel spreadsheet with the following 5 columns:
Invoice Number, 2) Company, 3) Primary Email address, 4) Secondary Email address(es), 5) Account Number
I also have a folder that contains invoices. Each invoice has the invoice number in its file name -- i.e., Inv_123456.pdf
I want to build an excel macro that -- when I provide a list of invoice number(s) will:
Open an email -- To: <Primary Contact, Cc: <Secondary contacts, and Bcc: <me,
Put the Invoice Number in the subject, and
Go to the folder containing the invoices and attach the corresponding invoice named InvNo_*.pdf, i.e., InvNo_123456.pdf
This is repeated for each invoice number and the email is displayed for review. *Initially, I want to display the email w/attachment until I am comfortable the macro works as expected.
The path to the folder containing the pre-filled invoices is --
C:\Users\christma-2\OneDrive - OurYear2Win\Documents\Clorodet\Invoice Emails\Attachments\Invoice_*.pdf
Following is the macro I've created so far. I would like to pull the invoice with the corresponding invoice number and attach it to the email.
Sub Send_Email_to_List()
Dim OL As Object, MailSendItem As Object
Dim MsgTxt As String
Set OL = CreateObject("Outlook.Application")
For Each xCell In ActiveSheet.Range(Range("C1"), Range("C" & Rows.Count).End(xlUp))
user_email = xCell.Value
user_subject = "Subject Line for the Email"
user_msg = "Thank You For Submitting this email"
Set MailSendItem = OL.CreateItem(olMailItem)
With MailSendItem
.Subject = user_subject
.Body = user_msg
.To = user_email
.CC = " "
.Bcc = "clorodet20607#aol.com"
'I need help getting the correct attachment, putting the invoice number in the subject, and cc'ing the secondary contacts
.Attachments.Add ("C:\Users\christma-2\OneDrive - OurYear2Win\Documents\Clorodet\Invoice Emails\Attachments\W1\???.pdf")
.Display
End With
Next xCell
Set OL = Nothing
End Sub
Find the corresponding contact's email address -- To: <Primary Contact, Cc: <Secondary contacts, and Bcc: <me,
You can use the CreateRecipient method creates a Recipient object. The name of the recipient; it can be a string representing the display name, the alias, or the full SMTP email address of the recipient. So, there is no need to search for the contact.
Sub ResolveName()
Dim myNamespace As Outlook.NameSpace
Dim myRecipient As Outlook.Recipient
Dim CalendarFolder As Outlook.Folder
Set myNamespace = Application.GetNamespace("MAPI")
Set myRecipient = myNamespace.CreateRecipient("Eugene Astafiev")
myRecipient.Resolve
If myRecipient.Resolved Then
Call ShowCalendar(myNamespace, myRecipient)
End If
End Sub
Sub ShowCalendar(myNamespace, myRecipient)
Dim CalendarFolder As Folder
Set CalendarFolder = myNamespace.GetSharedDefaultFolder(myRecipient, olFolderCalendar)
CalendarFolder.Display
End Sub
You can get a Contact instance by using the following sequence of calls:
recipient.AddressEntry.GetContact()
The Outlook object model supports three main ways of customizing the message body:
The Body property returns or sets a string representing the clear-text body of the Outlook item.
The HTMLBody property of the MailItem class returns or sets a string representing the HTML body of the specified item. Setting the HTMLBody property will always update the Body property immediately. For example:
Sub CreateHTMLMail()
'Creates a new e-mail item and modifies its properties.
Dim objMail As Outlook.MailItem
'Create e-mail item
Set objMail = Application.CreateItem(olMailItem)
With objMail
'Set body format to HTML
.BodyFormat = olFormatHTML
.HTMLBody = "<HTML><BODY>Enter the message text here. </BODY></HTML>"
.Display
End With
End Sub
The Word object model can be used for dealing with message bodies. See Chapter 17: Working with Item Bodies for more information.
Note, the MailItem.BodyFormat property allows you to programmatically change the editor that is used for the body of an item.
Related
This code is in MS Access (2010) VBA, using the Redemption library with Microsoft Outlook 2010.
I had this process working before, but we recently had a Citrix upgrade that I guess reset something in my Outlook and now the process no longer works.
I have a folder of .msg files which are basically pre-made email templates with all the proper formatting, images, text, etc.
This is what I was doing before:
Dim outlookApp As Object, namespace As Object
Dim oItem, MyItem
Set outlookApp = CreateObject("Outlook.Application")
Set namespace = outlookApp.GetNamespace("MAPI")
namespace.Logon
Set MyItem = outlookApp.CreateItemFromTemplate(path_to_dot_msg_file)
'And then there are many calls like this:
MyItem.HTMLBody = Replace(MyItem.HTMLBody, "Dear Person,", "Dear " & name)
'...
Set safeItem = CreateObject("Redemption.SafeMailItem")
Set oItem = MyItem
safeItem.Item = oItem
'this next line displays the email, and as of this line, it looks correct
'safeItem.Display
'but as of this line, the issue occurs
safeItem.HTMLBody = "<p>This is an extra message that shows up before the .msg file</p>" & safeItem.HTMLBody
safeItem.Recipients.ResolveAll
safeItem.Send
Now when the email is sent, the .msg contents aren't present at all -- the only thing that shows up is the "extra message" that I prepended to the HTMLBody.
What do I need to change or update? Is this something I need to change in the code, or in my Outlook settings, etc?
Extra: body insertion:
Function insertStringBodyTag(htmlBody As String, stringToInsert As String)
Dim s As String
Dim i As Integer
s = htmlBody
i = InStr(1, s, "<body")
i = InStr(i, s, ">")
s = Left(s, i) & stringToInsert & Right(s, Len(s) - i)
insertStringBodyTag = s
End Function
'Called with safeItem.htmlBody = insertStringBodyTag(safeItem.htmlBody, prefix_string)
You cannot concatenate 2 HTML strings and expect a valid HTML string back - the two must be merged - find the position of the "<body"substring in the original HTML body, then find the positon of the following ">" (this way you take care of the body element with attributes), then insert your HTML string following that ">".
I have a question. For example there is one view and 10 documents are in that view. Out of all those documents, 8 of them I should be the recipient of the email (based on the field value which is my email address).
Now, what I want to happen is that I will be receiving only one email for all those 8 documents, and in that email I there will be 8 doclinks.
Is that possible?
'Cause currently I am getting 8 emails and for each email, there is one doclink. Thanks in advance for those who can help me.
Dim s As NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim rtitem As NotesRichTextItem
Dim i As Integer
Dim view As NotesView
Set s = New NotesSession
Set db = s.CurrentDatabase
Set view = db.GetView("View")
Set doc = New NotesDocument(db)
Dim addresses As NotesName
i=0
Set doc = view.GetFirstDocument
While Not(doc Is Nothing)
Set addresses = New NotesName(doc.Manager(0))
If addresses.abbreviated = "" Then
i = i + 1
Else
doc.SendTo = addresses.abbreviated
doc.Form = "Memo"
Set rtitem = New NotesRichTextItem(doc, "Body")
Call rtitem.AppendText("Balance")
Call rtitem.appenddoclink(doc, "Link")
doc.Send (True)
i = i + 1
End If
Set doc = view.GetNextDocument(doc)
Wend
As Thorsten said, it can be done. There are a couple of ways to handle this, depending on how flexible and future proof you want it, and how "clean" of a solution you want.
Let's say you have 10 documents, 8 with your email and 2 with a different user's email. I assume you want to send one mail to you with 8 doc links and one to the other person with 2 doc links.
The way I would do it is to create a class. That class would contain a list of NotesDocuments (and a method to add documents to the list):
Class DocData
Public docs List As NotesDocument
Public Sub New()
End Sub
Public Sub Add(doc as NotesDocument)
Set docs(doc.UniversalID) = doc
End Sub
End Class
In your main code, you have a list of DocData objects, one per mail recipient:
Dim docs List As DocData
You now loop through the view or the document collection you have. You check the email address for each document and if there isn't a list item for that address, you create it and add the document to it. If it already exists, just add the document:
email = doc.GetItemValue("EmailAddress")(0)
If !IsElement(docs(email)) Then
Set docs(email) = New DocData()
End If
Call docs(email).Add(doc)
When all documents have been processed, you should have a list with one item per mail recipient, and you can loop through the list, build one email per item and populate it with doc links for all the documents in the list in the object.
For performance reasons, if you plan to have this working on larger views with more documents, I woudl suggest that you put the email address in one of the columns, and then use view entries to loop though the documents, and ColumnValues() to read the email address.
I wrote about it here: http://blog.texasswede.com/re-using-lotusscript-lists-to-increase-performance/
Your code can be slightly modified to only send one mail:
Dim s As NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim rtitem As NotesRichTextItem
Dim i As Integer
Dim view As NotesView
Set s = New NotesSession
Set db = s.CurrentDatabase
Set view = db.GetView("View")
Set doc = New NotesDocument(db)
Dim addresses As NotesName
i=0
'- prepare mail
doc.Form = "Memo"
Set rtitem = New NotesRichTextItem(doc, "Body")
Call rtitem.AppendText("Balance")
Set doc = view.GetFirstDocument
While Not(doc Is Nothing)
Set addresses = New NotesName(doc.Manager(0))
If addresses.abbreviated = "" Then
i = i + 1
Else
'- Set recipient
If not doc.HasItem( "SendTo" ) then
doc.SendTo = addresses.abbreviated
End If
'- Append descriptive text, link and new line
Call rtitem.appendtext(doc.Subject(0) & " " )
Call rtitem.appenddoclink(doc, "Link")
Call rtitem.addnewline(1)
i = i + 1
End If
Set doc = view.GetNextDocument(doc)
Wend
'- send mail
Call doc.Send (True)
with that code the mail is first prepared, then a doclink is added for every document, and in the end the mail is sent.
I'm using an MS access query in which I want to pull all the emails from the query and then populate an outlook email with all the emails, the code will run but, it does not pull in the email addresses and i cannot seem to figure out why.. here is what i have so far. My thoughts are than the query used in populating the table is not being called when trying to pull the emails
Private Sub Command30_Click()
On Error GoTo Err_Command30_Click
Dim stDocName As String
stDocName = "Department E-Mail"
DoCmd.OpenQuery stDocName, acNormal, acEdit
Dim r As Recordset
Dim Email As String
Set r = CurrentDb.OpenRecordset("SELECT[tbl dmgrphcs].Email FROM [tbl dmgrphcs]WHERE(([tbl dmgrphcs].Email) Is Not Null);")
Do While Not r.EOF
Email = Email & r(0) & ";"
r.MoveNext
Loop
r.Close
DoCmd.SendObject acSendNoObject, Null, Null, "", "", Email, "", "", True, Null
Exit_Command30_Click:
Exit Sub
Err_Command30_Click:
MsgBox Err.Description
Resume Exit_Command30_Click
End Sub
Your use of the table name is not consistent
[tbl dmgrphcs]
[tbl dmgrphcs]
[tbl dmgrphcs]
The number of spaces matters. If the query accesses only one table you don't need to prefix the columns with the table name
Set r = CurrentDb.OpenRecordset("SELECT Email FROM [tbl dmgrphcs] " & _
"WHERE Email Is Not Null")
Hint: Give your buttons meaningful names before adding event handlers. Command30 does not speak. btnPullEMails or cmdPullEMail does. The event handler will then have a better name too:
Private Sub btnPullEMails_Click()
I am have the following code for excel vba that will email a range of addresses in my sheet. Howeve, I am looking to maybe use an inputbox to determine what the range is that I would like to email. The trouble i run into is getting the input to become a value that the function mailid understands. any suggestions?
Sub EmailActiveSheetWithOutlook2()
Dim oApp, oMail As Object, _
tWB, cWB As Workbook, _
FileName, FilePath As String
Application.ScreenUpdating = False
'Set email id here, it may be a range in case you have email id on your worksheet
Sheets("Sheet1").Select
mailId = Range("b4:b5").Value
'Write your email message body here , add more lines using & vbLf _ at the end of each line
Body = "Hello, it appears you have not yet filled out the transportation contact information excel sheet. This sheet was emailed to you, please complete this and send to me saved as your firstnamelastname.xls at your earliest convience." & vbLf _
& vbLf _
& "Thanks & Regards" & vbLf _
& vbLf _
& "-Ryan " & vbLf _
'Sending email through outlook
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
With oMail
.To = mailid
.Subject = "Transportation Committee Notice"
.Body = Body
'.Attachments.Add tWB.FullName
.send
End With
End Sub
To replicate the effect of your current code use
mailid = Application.InputBox(Prompt:="Select Range", Type:=8)
where Type:=8 specifies a return type of Range. This returns the Value property of the selected range into mailid
Alternatively use
Dim rng as Range
Set rng = Application.InputBox(Prompt:="Select Range", Type:=8)
mailid = rng.Value
rng is then set to the selected range, and can be validated before use
Note that you should add error handling to account for, eg user Cancelling the InputBox
Do not set Application.ScreenUpdating = False before issuing InputBox as this will prevent the user interacting with the screen.
As an aside, your code uses Dim incorrectly: Dim'ing a variable without a As clause declares it as `Variant.
eg
Dim oApp, oMail As Object
actually declares oApp as a Variant, use
Dim oApp As Object, oMail As Object
I've created a form in Word 2010, and I added a button to send the form.
What i want is that when the button is clicked, the form is attached to an email message, and a specific email address is automaticlly entered in the 'To' field of the message.
I managed to get the button to open an email message and add the form as an attachment, but I can't get it to enter my email address.
It depends on how you are generating the email message. For example, see below for one method.
Private Sub CommandButton1_Click()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "test#test.com"
.CC = ""
.BCC = ""
.Subject = "Subject goes here"
.Body = "Text of body goes here."
.Attachments.Add (\file\to\attach.txt)
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub