Automate trigger from email that has been replied - excel

I am new in VBA. I would like to ask on how to trigger email which has been reply.
Scenario : I have this coding as below which send the email to recipient (Column B) if there is "yes" in column C.
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*#?*.?*" And _
LCase(Cells(cell.Row, "C").Value) = "yes" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Reminder"
.Body = "Dear " & Cells(cell.Row, "A").Value _
& vbNewLine & vbNewLine & _
"Please contact us to discuss bringing " & _
"your account up to date"
'You can add files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'Or use Display
End With
Question : How can I trigger if the recipient has replied to my email that I sent earlier? I would like to automate the trigger to my excel file on column E as remark recipient has replied to my email. Ex, "replied / no reply".
Really appreciate for any help since I am new in VBA.
Thank you.

Assuming your using Microsoft Outlook and an Exchange Server.
There are 3 Extended MAPI properties that deal with the message state for replied to/forwarded:
PR_ICON_INDEX (0x10800003)
PR_LAST_VERB_EXECUTED (0x10810003)
PR_LAST_VERB_EXECUTION_TIME (0x10820040)
This MSDN article https://msdn.microsoft.com/en-us/library/bb176395(office.12).aspx provides code that shows how to use these MAPI Properties:
Sub DemoPropertyAccessorGetProperty()
Dim PropName, Header As String
Dim oMail As Object
Dim oPA As Outlook.PropertyAccessor
'Get first item in the inbox
Set oMail = _
Application.Session.GetDefaultFolder(olFolderInbox).Items(1)
'PR_TRANSPORT_MESSAGE_HEADERS
PropName = "http://schemas.microsoft.com/mapi/proptag/0x007D001E"
'Obtain an instance of PropertyAccessor class
Set oPA = oMail.PropertyAccessor
'Call GetProperty
Header = oPA.GetProperty(PropName)
Debug.Print (Header)
End Sub
You will want to replace the 'PR_TRANSPORT_MESSAGE_HEADERS ie 0x007D001E in the above code and I'm guessing you'll want to go through more than just the first mail item...

Related

Use VBA to send mass email

I'm taking over a workbook created from the last employee. There's a specific coding that I cannot figure out where it states to grab the email list from to plug into the BCC line.
I'm not finding anywhere in the code that states that but the macro somehow works. It is able to extract the email addresses and plug them into the bcc line on the email template. I see that they specified bc_r but I don't see any worksheets name RecipientEmails. The only worksheet with a list of email addresses in this workbook that I see is in the same tab as the command button to pull this email template. The email address is listed on this sheet under column T. So, I'm unsure why the code says c1. Please review the codes below and if you can guide me, I'd appreciate it.
Sub esendemail()
Dim outlook As Object
Dim newEmail As Object
Dim xInspect As Object
Dim pageEditor As Object
Set outlook = CreateObject("Outlook.Application")
Set newEmail = outlook.CreateItem(0)
bc_r = ""
For Each c1 In Range("RecipientEmails")
bc_r = bc_r & ";" & c1.Value
Next c1
With newEmail
.To = ""
.BCC = bc_r
.Subject = "Welcome to the team!"
.Body = "[Greetings]" & vbCrLf & " " & vbCrLf & "Practice Name:"
.Display
Set xInspect = newEmail.GetInspector
Set pageEditor = xInspect.WordEditor
Set pageEditor = Nothing
End With
Set newEmail = Nothing
Set outlook = Nothing
End Sub
The email addresses are retrieved in the named range:
bc_r = ""
For Each c1 In Range("RecipientEmails")
bc_r = bc_r & ";" & c1.Value
Next c1
Check out the RecipientEmails named range in your worksheet. See Create a named range from selected cells in a worksheet for more information about named ranges.
Also I'd recommend using the Recipients property for setting up recipients on the Outlook item. You can read more about that approach in the article I wrote for the technical blog, see How To: Fill TO,CC and BCC fields in Outlook programmatically for more information.

Send email from today's date

I have an excel spreadsheet for permits, and one column is their expiration dates. My boss wants to be emailed about the permits that expire in the next 2 weeks. How can I use visual basic to tell Outlook to send an email each time he opens the excel spreadsheet?
This is for a spreadsheet I set up, permit names are in column A, dates are in column J.
Sub Mail_small_Text_Outlook()
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "Hi there" & vbNewLine & vbNewLine & _
"Cell A1 is changed" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"
On Error Resume Next
With OutMail
.To = "ron#debruin.nl"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = strbody
'You can add a file like this
'.Attachments.Add ("C:\test.txt")
.Display 'or use .Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
I may have to use a button to run the program, but I'm not sure if it is possible to schedule emails.
It appears that you have not dimmed OutApp as an object.
Once that is done add a loop examining the expiration dates and adding the specific cells to a dynamic array, re-dimming the array with each iteration. Finally each license on the array will need to be added to a text string that can then be added to the body of the email you are creating above....
Once you have all the above working as you would like, you will want to tie the whole operation to the Workbook Open event.
In the VBE, open This Workbook...
Then use the drop-down menus to select the Workbook and Open Event and add your code and save.

Macros to Send attach different files to multiple individual emails, vba

I am a computer technician, not a programmer, but in my new job I have been asked to finish a macros in excel (vba).
It consists of a list of id card numbers in one of the columns (the number of cells is variable each time it is used, one day you can put 20 people and another 12 for example), and emails in another column.
In a folder there are some pdf documents whose name is the id card of the person that appears in the excel.
What they ask me is that, being ordered the id card in alphabetical order, take the id card and email. The id card will serve to find your corresponding pdf and add it as an attachment with the idea of sending it by email, to whom? there the cell is used with the email data. This has to be done with each of the existing rows, take pdf file to attach it and send email to the address of that same row until there are no more rows on the sheet.
Can someone tell me how to do that or tell me the functions I need?
Thank you.
Graphical idea:
The macro is currently set to .Display the email and not send. After you have finished running tests you will want to change this to .Send to actually send the email.
You will also need to update the value of strLocation. Inside the quotes is where you will need to put the location of the folder that houses all of your target PDFs.
The order of your cells doesn't matter here as long as each row is associated to one individual.
Hopefully these emails are internal - you should not use this for external mailing lists as you cannot offer the option to unsubscribe. Outlook may flag/ban your account if you are suspected of spam.
This assumes the values in Column C are actual email addresses that will be recognized as is by Outlook. (urdearboy#email.com)
Sub CorpCard()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("C").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*#?*.?*" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.SentOnBehalfOfName = "[your associated Outlook email here]"
.to = cell.Value
.Subject = "Subject goes here"
.Body = "Hi " & Range("B" & cell.Row).Value & "," _
'Body to be patsed here
strLocation = "C:\Users\urdearboy\Desktop\File Name\" & Cells(cell.Row, "D").Value & ".pdf"
.Attachments.Add (strLocation)
.Display
'.Send
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub

How can I use VB code in Outlook2007 to send a series of meeting invites using sendonbehalfof as a delegate

I am trying to write some VB code within Excel 2007 that will automatically send out meeting invites from the Outlook 2007 Calendar, to a list of addressees listed in the excel spreadsheet, on the dates specified within the spreadsheet. This is useful because I can send out hundreds of meeting requests to different people on different dates with one click of a button. I can do this fine when sending from my own user account with the following code:
' Create the Outlook session
Set myoutlook = CreateObject("Outlook.Application")
' Create the AppointmentItem
Set myapt = myoutlook.CreateItem(olAppointmentItem) ' Set the appointment properties
With myapt
.Subject = " Assessment Centre "
.Location = "conference room A"
.Start = Cells(5, 24 + j) & " 17:00:00 PM"
.Duration = 120
.Recipients.Add Cells(i, 1).Value
.MeetingStatus = olMeeting
' not necessary if recipients are email addresses
'myapt.Recipients.ResolveAll
.AllDayEvent = "False"
.BusyStatus = "2"
.ReminderSet = False
.Body = L1 & vbCrLf & vbCrLf & L2 & vbCrLf & vbCrLf & L3 & vbCrLf & vbCrLf & L4
.Save
.send
End With
But now I want to send the meeting request from a dummy user account for which I am a delegate using something like ’sendonbehalfof’ so that the dummy calendar stores all the meeting invites, and other delegates can operate the system as well using the same dummy user account. This works fine when sending an email with the following code:
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
With oMail
.To = " John.Smith#John_Smith.com "
.Subject = "Subject"
.Body = "Body"
.SentOnBehalfOfName = "Fred.bloggs#fred_blogs.com"
.send
End With
The email will say from ’me on behalf of Fred Bloggs’
But I can’t get it to work with Calendar appointments.
I’ve searched high and low with words like ‘appointment’, ‘meeting request’, sendonbehalfof’ etc, and it seems you should be able to do this for appointments with ’sendusingaccount’ but this doesn’t seem to work (it doesn’t fail, just ignores the instruction and sends from my own user account as before).
Can anyone tell me how to do this?
Thanks very much.
If you have delegate access to another user's mailbox, use GetSharedDefaultFolder to obtain a reference to the user's shared calendar, then use Folders.Items.Add to add the meeting to their calendar.
Ex:
Dim fldr As Outlook.Folder
Dim appt As Outlook.AppointmentItem
Set fldr = Session.GetSharedDefaultFolder(_
Outlook.CreateRecipient("Fred.bloggs#fred_blogs.com"), _
olFolderCalendar)
Set appt = fldr.Items.Add
' set up your appointment here
' i.e.:
' With appt
' .Start = Cells(5, 24 + j) & " 17:00:00 PM"
' .Duration = 120
' End With
' make sure you call the appt.Save method to save the appt!
Adapted from: http://www.outlookcode.com/codedetail.aspx?id=43

Excel VBA code to read a username from a cell then send an email to that user

I require some help in creating Excel VBA code which will read a row of usernames from cells in Excel and then send an email to all those users by searching for the users email address in the Outlook contacts list.
I have managed to write the code that will bring up outlook's compose email dialog box from the spreadsheet.
You can use for in range with mails and call this proc to send email
Public Sub SendMail(MailTO As String, MailSubject As String, MailBody As String)
'http://officevb.com
Dim appOL As Object
Dim myEmail As Object
Dim TxtHello As String
Set appOL = CreateObject("Outlook.Application")
Set myEmail = appOL.CreateItem(olMailItem)
'Use hour to create a text
Select Case Hour(Time)
Case Is <= 12
TxtHello = "Good Morning," & vbNewLine
Case Is >= 12
TxtHello = "Good Afternoom," & vbNewLine
Case Is >= 18
TxtHello = "Good Night," & vbNewLine
End Select
With myEmail
.display
.Recipients.Add MailTO
.Subject = MailSubject
.Body = TxtHello & MailBody
.Send
End With
Set myEmail = Nothing
Set appOL = Nothing
End Sub
call this sub passing these parameters
sendMail "Mail#yourContact.com","Test","This is a automatic mail"
[]´s

Resources