I'm somewhat new to VBA programming so please bear with me. I'm trying to automate the job of emailing my organization's department heads with a standard email but a personalized audit memos. Each email sent to a certain person should also contain the corresponding attachment.
I have a spreadsheet with three columns: name, email address, and the location of the file I'd like to attach in A, B, and C respectively. I've represented this the best I can below.
A....................B..................C
Name.............Email............Attachment
John Smith.....a#b.com.....Q:\PLIU\File1
Jane Smith.....c#d.com.....Q:\PLIU\File2
Jimm Smith.....e#f.com.....Q:\PLIU\File3
This is the code I have so far but I cannot figure out how to attach the file written into the attachment column, as debug gives me "Cannot find this file. Verify the path and filename are correct."
Sub AttachSend()
Dim objMail As Outlook.MailItem
Dim intX As Integer
Dim FileCount As Integer
Dim MailAttachment As String
Dim MailAddress As String
FileCount = Application.WorksheetFunction.CountA(Range("C2:C200"))
For intX = 1 To FileCount
MailAttachment = Application.Cells(intX, 3).Value
MailAddress = Application.Cells(intX, 2).Value
Set objMail = Outlook.Application.CreateItem(olMailItem)
objMail.Subject = "My subject line"
objMail.Body = "My message body"
objMail.To = MailAddress
objMail.Attachments.Add "MailAttachment"
objMail.Send
Set objMail = Nothing
Next
End Sub
Thanks in advance!
Remove the quotes around "MailAttachment". You want to use the MailAttachment variable, but currently you're using the string "MailAttachment", which of course does not exist as a file on disk.
MailAttachment = Application.Cells(intX, 3).Value
MailAddress = Application.Cells(intX, 2).Value
Set objMail = Outlook.Application.CreateItem(olMailItem)
objMail.Subject = "My subject line"
objMail.Body = "My message body"
objMail.To = MailAddress
objMail.Attachments.Add MailAttachment `Remove quotes on this line
Related
I'm using VBA to make automating emails from Excel to outlook however when I'm running my code it show compile error: variable not defined
I'm trying using from this source : https://beebole.com/blog/automating-emails-from-excel-employee-bonus/#copy
But, I only use Name, First Name, Send To, Email Subject, Email Body and Single-Send Link. For my Email Subject and Email Body I don't use any formula.
This my code in VBA
MY table for single-send link having an error
Formula in excel :
=HYPERLINK(“mailto:“&[#[Send To]]&”?subject=”&[#[Email Subject]]&”&body=”&[#[Email Body]],”SEND”)
[
Sub EmailAll()
Dim oApp As Object
Dim oMail As Object
Dim SendToName As String
Dim theSubject As String
Dim theBody As String
For Each c In Selection 'loop through (manually) selected records
'''For each row in selection, collect the key parts of
'''the email message from the Table
SendToName = Range("C" & c.Row)
theSubject = Range("D" & c.Row)
theBody = Range("E" & c.Row)
'''Compose emails for each selected record
'''Set object variables.
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
'''Compose the customized message
With oMail
.To = SendToName
.Subject = theSubject
.Body = theBody
''' If you want to send emails automatically, use the Send option.
''' If you want to generate draft emails and review before sending, use the Display option.
''' Do not use both!
'''To activate your chosen option: Remove the single quote from the beginning of the code line, then
'''add the single quote back to the option you didn't choose
.Display
'.Send
End With
Next c
End Sub
Can anyone help me to solve this problem
This is how the message should look in the email:
This is my Excel sheet:
I have an Excel file with columns from A to M, A being Payer, and M being the email address. I need a macro to sort by email address and create an email with the data associated with that email address.
I need a message on the email that reads:
Hello team,
Please review the items below and provide your comments for the invoices due in the account regarding payment details, let us know if there is additional information needed from our end so that we can send it as soon as possible.
That message would have to be able to be changed and my signature at the end.
The data on the columns is:
A Payer
B Name
C Invoice Number
D Bill. Date
E Net due date
F Days past due
G Aging
H Value
I Cust. Mat.
J PO Number
K Bill.Doc.
L Delivery
M Email
I would like to be able to check the emails before sending them.
This is a handy piece of code that includes your default signature in an email.
It is also possible to add attachements (just to keep in mind). You will need to play with it using the .diplay property until it looks pretty and the info you need included is all being pulled in correctly.
You can then create another sub to to iterate though each line of data you have and send those emails.
Option Explicit
Sub EmailIncludingSignature()
Dim eSubject As String
Dim eRecipient As String
Dim eBody As String
Dim SAVELOC As String
Dim objOutlook As Object
Dim objEmail As Object
Dim objAttachment As Object
Dim S As String
'Setup Email
Set objOutlook = CreateObject("Outlook.Application")
Set objEmail = objOutlook.CreateItem(olMailItem)
'Set objAttachment = objEmail.Attachments
'objAttachment.Add SAVELOC & ".pdf"
'Email Signature
S = Environ("appdata") & "\Microsoft\Signatures\"
If Dir(S, vbDirectory) <> vbNullString Then S = S & Dir$(S & "*.htm") Else S = ""
S = CreateObject("Scripting.FileSystemObject").GetFile(S).OpenAsTextStream(1, -2).ReadAll
'Email parameters
eSubject = "Test Email Signature"
eRecipient = "cameron.critchlow#westinbearmountain.com"
eBody = "" & _
"<br>Hi All,<br><br>" & _
"Last line,<br><br>" & S
'Build Email
With objEmail
.To = eRecipient
.CC = ""
.BCC = ""
.Subject = eSubject
.BodyFormat = olFormatHTML ' send plain text message
.HTMLBody = eBody
.Display
'.Send
End With
End Sub
Do you have experience with VBA? does the above make sense?
I am working on a project where I need to "draft" 5 emails, attach them to another email, and then send this nested email to a coworker.
My issue is that the 5 attached emails do not show a subject line. I wrote a little tester where the subject lines are also lost during the attaching
Private Sub emailtest()
'Declare Variables
Dim EmailMain As Outlook.MailItem
Dim EmailSub As Outlook.MailItem
Dim j As Long
'Create the main email object
Set EmailMain = Outlook.CreateItem(olMailItem)
With EmailMain
.To = "fake#fakeemail.org"
.Subject = "Testing Main"
.Body = "testing testing"
End With
'creating 5 email objects
For j = 1 To 5
'Create the sub email to be attached to the main email
Set EmailSub = Outlook.CreateItem(olMailItem)
'Details for this sub email
With EmailSub
.To = ""
.Subject = "Test: " & j
.Body = "Testing Nest: " & j
End With
'Attach the email to the main email
EmailMain.Attachments.Add EmailSub
Next j
EmailMain.Display
End Sub
After running this the displayed email has 5 emails, but they are all blank. No subject, no body, nothing.
Any help is appreciated.
You need to save the message being added as an attachment before it is attached:
EmailSub.Save
EmailMain.Attachments.Add EmailSub
Greetings for the day!
I have written a small VBA code to check if my team has responded to the client's email or not. on daily basis we get approx 500+ emails from the client, to track the same I have written the below code to check what all emails are being looked upon.
Dim O As Outlook.Application
Dim R As Long
Sub project2()
Set O = New Outlook.Application
Dim Omail As Outlook.MailItem
Set Omail = O.CreateItem(olMailItem)
Dim ONS As Outlook.Namespace
Set ONS = O.GetNamespace("MAPI")
Dim FOL As Outlook.Folder
Set FOL = ONS.GetDefaultFolder(olFolderInbox).Folders("MD-GPS")
R = 2
For Each Omail In FOL.Items
Cells(R, 1) = Omail.Subject
Cells(R, 2) = Omail.SenderEmailAddress
Call REPLY_STATUS(Omail.Subject, Omail.SenderEmailAddress)
R = R + 1
On Error Resume Next
Next Omail
End Sub
Sub REPLY_STATUS(MailSubject As String, MailSender As String)
Dim SentEmail As Outlook.MailItem
Set SentEmail = O.CreateItem(olMailItem)
Dim ONS2 As Outlook.Namespace
Set ONS2 = O.GetNamespace("MAPI")
Dim FOL2 As Outlook.Folder
Set FOL2 = ONS2.GetDefaultFolder(olFolderSentMail)
Dim check As String
check = "RE: " & MailSubject
For Each SentEmail In FOL2.Items
If check = SentEmail.Subject And MailSender = SentEmail.Recipients(1).Address Then
Cells(R, 3) = "Yes"
Exit For
Else
End If
On Error Resume Next
Next SentEmail
End Sub
But the ending is not that great as it looks, the code is working but
in most cases, the code captures something else rather than capturing the sender's email address in an excel sheet.
As we daily receive 500+ emails, the code becomes too slow as it checks the entire folder from the scratch, is there a possibility I can add a start date that I can mention in the excel sheet and the code will start from that date only.
Not sure why it is also not filling column 3 i.e. if replied however my team has actually replied to those emails.
it is not picking up the latest emails from the defined sub-folder ("MD-GPS"), why is that happening?
Any help on this would be greatly appreciated.
Note: To handle stmp exchange account error, I tried using the following MailItem.Sender.GetExchangeUser.PrimarySmtpAddress but the only drawback is if I change the sub-folder to something else, it doesn't work.
Firstly, you do not need to create SentEmail - get rid of the
Set SentEmail = O.CreateItem(olMailItem)
line.
Secondly, never loop through all items in a folder - use Items.Find/FindNext or Items.Restrict.
Thirdly, you are seeing an EX type address (as opposed to SMTP). Check MailItem.Sender.Type property - if it is "SMTP", use MailItem.Sender.Address. Otherwise (in case of "EX") use MailItem.Sender.GetExchangeUser().PrimarySmtpAddress.
That being said, you can check if anybody replied to the original message at all - check if PR_LAST_VERB_EXECUTED MAPI property (DASL name http://schemas.microsoft.com/mapi/proptag/0x10810003) is present - 103 is EXCHIVERB_REPLYTOALLand 102 is EXCHIVERB_REPLYTOSENDER. If the property is not set at all, there is no reason to search.
To search for a matching subject, use a query like
"[Subject] = ' & MailSubject & "'"
Note that Outlook Object Model will not let you search on the message recipients or attachments. If using Redemption (I am its author) is an option, you can use something like the following. You can specify Recipients as one of the search fields, and Redemption will create a restriction on recipient name / address / SMTP address
set session = CreateObject("Redemption.RDOSession")
session.MAPIOBJECT = O.Session.MAPIOBJECT
set SentEmail = FOL2.Items.Find("""http://schemas.microsoft.com/mapi/proptag/0x0E1D001F"" = '" & MailSubject & "' AND Recipients = '" & MailSender & "'")
Note that most MAPI stores won't search on PR_SUBJECT, only on PR_NORMALIZED_SUBJECT (which is the subject without the RE: or FW: prefix) - which is what the snippet above is using.
In VBA scripting ,I am trying to write a Sub Function which has the following signature
Sub(taskName As String , myGroup As String, myFile As String ,myPer As String, RelatedTasks() As String )
Dim olApp As Outlook.Application
Dim m As Outlook.MailItem
Set olApp = New Outlook.Application
Set m = olApp.CreateItem(olMailItem)
With m
.display
.To = "somewhere#someplace.com"
.Subject = "Test Events"
.HTMLBody/.body = ...
End Sub
Email Body is as follows:
Hello All,
Please find the following information.
TASK: taskName
RELATED TASK:RelatedTasks()
FILE : myFile
PERSON : myPer
In the Sub function , the pattern to the left of colon is always constant.And the right side will change based on the inputs to the function.
For that I am reading the Template.htm which contains the required signature.
Template.htm contains:
Hello All,
Please find the following information.
TASK: {{mytask}}
RELATED TASK:{{myRelatedTasks}}
FILE : {{myFile}}
PERSON : {{myPerson}}
In VBA code,I am replacing all the fields.
The issue that I am facing is {{mytask}} and {{related tasks}} also should have a HTML reference. I have succeeded in adding the link to mytask .Clicking on the mytask in the mail will jump to the respective weblink.
<a href = "www.something.com&id ={{taskID}}>
{{mytask}}.....<a href = "www.xxx.com&id={{}}>{{myRelatedTasks}}
but having trouble in adding the same to Related tasks since it is an array.
My VBA code :
Option Explicit
Sub CreateNewMail()
Dim olApp As Outlook.Application
Dim m As Outlook.MailItem
Dim sigPath As String, sigText As String
Dim fso As Scripting.FileSystemObject
Dim ts As Scripting.TextStream
Dim t As String
Dim r(5) As Variant
t = "233444:dshfjhdjfdhjfhjdhfjdhfjd"
r(0) = "122343:dsjdhfjhfjdh"
r(1) = "323243:jfjfghfjhjddj"
r(2) = "834783:gffghjkjkgjkj"
Set olApp = New Outlook.Application
Set m = olApp.CreateItem(olMailItem)
sigPath = "C:\Users\Pavan-Kumar\Desktop\vbs\TestEvents.htm"
Set fso = New Scripting.FileSystemObject
Set ts = fso.OpenTextFile(sigPath)
sigText = ts.ReadAll
ts.Close
Set fso = Nothing
sigText = Replace(sigText, "{{mytask}}", t)
sigText = Replace(sigText, "{{myRelatedTasks}}", Join(r, "<br>"))
With m
.display
.To = "somewhere#someplace.com"
.Subject = "Test Events"
.HTMLBody = sigText
End With
End Sub
And also when I am joining the related tasks , I want them to come one below another with indentation. I tried it with giving "\t" as the delimiter with no success.
I want to give references to my Related tasks and also want them to neatly align them. Thanks.
This is what I am able to print in my outlook mail:
Hello All,
Please find the following information.
TASK: 233444:dshfjhdjfdhjfhjdhfjdhfjd
RELATED TASK:122343:dsjdhfjhfjdh
"\t"323243:jfjfghfjhjddj
"\t"834783:gffghjkjkgjkj
"\t"
"\t"
"\t"
FILE : TImers
PERSON : Charvaka
For the Alignments: You can either drop the Related Tasks into a Table, or you can use a Tab (vbTab, not "\t")
For the multiple-rows: This would be simpler if you had a 2D Array (e.g. r(0,0)="RelatedTaskName" and r(0,1)="RelatedTaskID") instead of splitting it based on a Colon, but it's doable, and there are several different ways to go about it.
The method that I am going to use here is to build all of your string at once, then use Replace to dump the finished product: (using Tab instead of a Table for the indents)
Dim taskID As String, taskName As String, lTaskNum As Long, TaskList As String
TaskList = "" 'Start with an empty list
For lTaskNum = LBound(r) To UBound(r)
If Len(TaskList) > 0 Then TaskList = TaskList & vbTab 'We are using Tab instead of a table here
taskName= r(lTaskNum) 'Grab element from the array
taskID = Left(taskName, InStr(taskName, ":") - 1) 'Just the number
taskName = Replace(taskName, taskID & ":", "",count:=1) 'Just the Link text
TaskList = TaskList & "" & taskName & "<br />" 'Add the task to the stack
Next lTaskNum
'If Len(TaskList) < 1 Then TaskList = "No Related Tasks" 'Optional bonus!
sigText = Replace(sigText, "{{myRelatedTasks}}", TaskList) 'Push the finished list into the email