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

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

Related

Sending an Email with VBA Based on Address from Specific Cell In a Filtered Table

This may sound similar to other posts on StackFlow, but it is not. I could not find a thread targeting this issue.
Every month, I reach out to custodians concerning accounts I manage. I have a sheet that contains a table with all the accounts and their respective custodians in a single table. I filter by column E, and based on the custodian, I copy and paste the table with the information related to the respective custodian in the body of the email. This is a tedious process, so I attempted to create a macro that prepares and formats the email to my liking.
There is just one issue. If you take a look at the logic below the email address used is pulled from the email address located in column F. My initial thought was to filter the custodian I want, and when I press the button to trigger the macro, it would search the first cell in column F (F2) and inserts in the "To" field in the email. So, if I choose Bank of America, it works great because the email is in cell F2, and the Macro pulls that email correctly. The problem occurs when I filter for a different custodian. I thought the macro will look in that same area and pull the proper email address for the specific custodian. Because I filter the table, the custodian I am filtering is essentially in another cell, so it does not pull from what I filtered by. For example, let's say I filter for State Street in column E, despite the table looking like it is in the same place as Bank of America it is essentially in F22, so the macro does not pull the email for State Street. It instead pulls the email address for Bank of America in cell F2. Is there a way to direct the macro to look in the area rather than the specific cell reference to pull the email I want to send to thus limiting the issue if I filter the table?
Private Sub CommandButton1_Click()
Dim Sht As Excel.Worksheet
Set Sht = ThisWorkbook.ActiveSheet
Recip = [F2].Value & "; " ' <-- !
Dim rng As Range
Set rng = Sht.Range("A2:F26")
rng.Copy
Dim OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Dim OutMail As Object
Set OutMail = OutApp.CreateItem(0)
Dim vInspector As Object
Set vInspector = OutMail.GetInspector
Dim wEditor As Object
Set wEditor = vInspector.WordEditor
With OutMail
.TO = Recip
.CC = ""
.Subject = "STIF Vehicle Confirmation" & " - " & [E2].Value ' <-- !
.display
wEditor.Paragraphs(1).Range.Text = "Hello All," & Chr(11) & Chr(11) & "I hope this email finds you all doing well." & Chr(11) & Chr(11) & _
"Can you please confirm if the below STIF vehicle details are accurate for the accounts below? If the vehicle has changed, can you please confirm the new STIF vehicle name and CUSIP?" & vbCrLf
wEditor.Paragraphs(2).Range.Paste
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

How attach PDF, where location in different Excel sheet from same workbook, to Outlook mail?

I am trying to attach a PDF from a shared drive to many Outlook emails generated by a VBA code in Excel.
One sheet has all of the email addresses that will have an email created.
The other sheet in the same workbook has inputs such as the subject line, email body text, and PDF location that can be changed based on what the mass email is about.
While the code to make the subject and htmlbody of the email works, the attachment code doesn't work.
Copying the PDF address to a cell in the active worksheet with the lines of email data, I can attach the PDF.
It is when I treat it as an input on the Inputs worksheet that the issue occurs.
Sub Email_New_Patent_Case()
Dim i As Integer
Dim AttorneyCount As Long
'Set the end of the range equal to the last row of attorney data in the sheet
AttorneyCount = WorksheetFunction.CountA(Range("B2:B10"))
For i = 1 To AttorneyCount
If ActiveSheet.Cells(i + 1, 16) > 0 Then
Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")
Dim objEmail As Object
Set objEmail = objOutlook.CreateItem(olMailItem)
With objEmail
.To = ActiveSheet.Cells(i + 1, 10).Value
.CC = ""
'Make sure this cell corresponds with the Subject Line
.Subject = ActiveWorkbook.Worksheets("Inputs").Range("D3")
'Make sure nickname has nickname or first name as value
.HTMLBody = ActiveSheet.Cells(i + 1, 4).Value & ",<br><br>"
'Make sure this cell corresponds with the Body
.HTMLBody = .HTMLBody & ActiveWorkbook.Worksheets("Inputs").Range("D4")
'Make sure this cell corresponds with
' the desired attachment location on the shared drive
.Attachments.Add ActiveWorkbook.Worksheets("Inputs").Range("D5")
.Save
End With
End If
Next i
End Sub
I get an error message:
"Object doesn't support this property or method."
This is a bit ambiguous:
.Attachments.Add ActiveWorkbook.Worksheets("Inputs").Range("D5")
...because Attachments.Add can take either a string representing the full file path or an actual object. In this case Add is unable to tell whether you're trying to add the cell itself, or its Value - seems like it defaults to trying to add the range object instead of reading the cell's default property (Value)
Being more explicit fixes the problem:
.Attachments.Add ActiveWorkbook.Worksheets("Inputs").Range("D5").Value
I am trying to attach a PDF from a shared drive to many Outlook emails
and
.Attachments.Add ActiveWorkbook.Worksheets("Inputs").Range("D5") 'Make sure this cell corresponds with the desired attachment location on the shared drive
The source of the attachment can be a file (represented by the full file system path with a file name) or an Outlook item that constitutes the attachment.
So, you need to copy files on the hard drive first and then attach them passing a local file path.

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.

VBA Send bulk emails performance concern

I have the below macro which will scan an excel file with manager emails down Col B. For each manager, an email will be drafted/an excel file attached/ and sent automatically. I have been able to test this and it is working fine when drafting 50 - 100.
My concern is, 50 - 100 emails does not seem like a good indicator of knowing if this will work fine when sending 5,000 emails.
Am I at risk of this freezing or other issues when running this on actual file with 5,000 emails?
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("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
.SentOnBehalfOfName = "urdearboy#hi.com"
.to = cell.Value
.Subject = "Your Employees With A Corporate Credit Card - EID - " & Cells(cell.Row, "D").Value
.Body = "Hi " & Cells(cell.Row, "A").Value & "," _
'Body to be patsed here
strLocation = "C:\Users\urdearboy\Desktop\File Name " & Cells(cell.Row, "D").Value & ".xlsx"
.Attachments.Add (strLocation)
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
Would it be a good idea to house my For Each loop inside another loop something like For i = 1 to 5000 Step 50 and then add Do Events before starting the actual loop to give my computer some time to catch up before proceeding with the next 50 emails? I'm not exactly sure if this is in the scope of Do Events though. I can also provide computer specs if necessary.
This should work fine for larger files. With that number of emails to send though, your run time could easily be over an hour. A good idea might be to raise some flag in the error handler in case it does encounter an issue. Maybe something like:
if Err then
Msgbox "Error Encountered at Row " & cell.row
end if
right underneath the with-block.

Automate trigger from email that has been replied

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...

Resources