Forum Discussion

Codinho's avatar
Codinho
Copper Contributor
Mar 30, 2022
Solved

Automate Outlook emails using data from certain cells

For my job, I am required to receive packages, log them in Excel and send emails out to each person in my company notifying them that they have a package to pickup. There are between 40-80 packages we receive per day, so obviously even with copy and pasting a template email from a Word document this can take up a lot of time.

 

What I would like to do is expedite the process by automating the creation of a blanket email (something along the lines of "Hello, we received a package down in this location and is ready for pickup. Tracking number is 'A'") with A = data from the 'A' column. The 'To' section of the email would be populated from the 'B' column data, and the subject line of the email populated from the 'C' column data ( _____ Package, with the blank being 'C' column data such as UPS/FedEx/DHL etc.) Any help with creating a macro or something along those lines would be great!

excel
Macros and VBA
  • HansVogelaar's avatar
    HansVogelaar
    Mar 30, 2022

    Codinho 

    The following requires that the user has Outlook as email application. It works best if Outlook is already running.

    Sub CreateEmails()
    Dim objOL As Object
    Dim objMsg As Object
    Dim r As Long
    Dim m As Long
    Set objOL = CreateObject("Outlook.Application")
    m = Range("A" & Rows.Count).End(xlUp).Row
    For r = 2 To m
        Set objMsg = objOL.CreateItem(0) ' olMailItem
        objMsg.Subject = Range("C" & r).Value & " Package"
        objMsg.To = Range("B" & r).Value
        objMsg.Body = "Hello, we received a package down in this " & _
            "location and is ready for pickup. Tracking number is " & _
            Range("A" & r).Value
        objMsg.Display
    Next r
End Sub

2 Replies

  • HansVogelaar's avatar
    HansVogelaar
    MVP
    Mar 30, 2022

    Codinho 

    The following requires that the user has Outlook as email application. It works best if Outlook is already running.

    Sub CreateEmails()
    Dim objOL As Object
    Dim objMsg As Object
    Dim r As Long
    Dim m As Long
    Set objOL = CreateObject("Outlook.Application")
    m = Range("A" & Rows.Count).End(xlUp).Row
    For r = 2 To m
        Set objMsg = objOL.CreateItem(0) ' olMailItem
        objMsg.Subject = Range("C" & r).Value & " Package"
        objMsg.To = Range("B" & r).Value
        objMsg.Body = "Hello, we received a package down in this " & _
            "location and is ready for pickup. Tracking number is " & _
            Range("A" & r).Value
        objMsg.Display
    Next r
End Sub
    • MilletSoftware's avatar
      MilletSoftware
      Brass Contributor
      Mar 31, 2022
      You will need some mechanism to avoid repeat emails for the same package.
      For example, extend the code to also check for and update a cell in a column called 'Done'.

Resources