Results 1 to 5 of 5

Thread: Excel VBA to insert cell data into outlook email

  1. #1

    Excel VBA to insert cell data into outlook email



    Register for a FREE account, and/
    or Log in to avoid these ads!

    I've created a log that tracks our office library resources. When a checked out book becomes overdue, I've added code that automates sending an email to the person who checked out the resource notifying them of the overdue book. The code below works beautifully and i'm able to successfully generate the email and send, but only with the .body set to specific text. I would like to also add a carriage return and insert the title of the book that is past due. Below is the code I'm struggling with.

    Code:
    Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("H3").Value = "OVERDUE" Then
     sendBook (Range("I3").Text)
    
    End If
     End Sub

    And:

    Code:
    Sub sendBook(theAddy As String)
     
     Application.ScreenUpdating = False
     Application.EnableEvents = False
     Dim wb As Workbook, wasOpen As Boolean
     On Error Resume Next
     wasOpen = True
     Workbooks(Sheet1).Activate
     If Err <> 0 Then
     Set wb = Workbooks.Open("C:\Users\op936sp\Documents\ADMIN\Library\Library Check In-Check Out.xlsx")
     wasOpen = False
     Err.Clear
     Else
     Set wb = ActiveWorkbook
     wb.Save
     End If
     Dim olApp As Object, olMsg As Object
     Set olApp = CreateObject("Outlook.Application")
     Set olMsg = olApp.CreateItem(0)
     With olMsg
     .To = theAddy
     .cc = (my email address)
      .Subject = "Overdue Library Book Alert"
     .Body = "Please return the overdue resource listed below to MS 56.  If you would like to request an extension, please contact Stephanie Kutchinski at ext. 4686." (Here is where is want to insert a carriage return and include the library book title found in column A) 
     .Send
     End With
     If wasOpen = False Then
     wb.Close True
     End If
     Application.ScreenUpdating = True
     Application.EnableEvents = True
     Set olApp = Nothing
     Set olMsg = Nothing
     End Sub
    Any help would be much appreciated!
    Last edited by Bob Phillips; 2014-04-30 at 08:25 AM. Reason: Addeded code tags

  2. #2
    Code:
    Private Sub Worksheet_Change(ByVal Target As Range)
        If Range("H3").Value = "OVERDUE" Then
        
            Call sendBook(Range("I3").Text, Range("A1").Text)
        End If
    End Sub
    
    
    
    Sub sendBook(ByVal theAddy As String, ByVal theBook As String)
    Dim wb As Workbook, wasOpen As Boolean
    Dim olApp As Object, olMsg As Object
     
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        
        On Error Resume Next
        wasOpen = True
        Workbooks(Sheet1).Activate
        If Err <> 0 Then
        
            Set wb = Workbooks.Open("C:\Users\op936sp\Documents\ADMIN\Library\Library Check In-Check Out.xlsx")
            wasOpen = False
            Err.Clear
        Else
        
            Set wb = ActiveWorkbook
            wb.Save
        End If
        
        Set olApp = CreateObject("Outlook.Application")
        Set olMsg = olApp.CreateItem(0)
        With olMsg
        
            .To = theAddy
            .cc = (my email address)
            .Subject = "Overdue Library Book Alert"
            .Body = "Please return the overdue resource listed below to MS 56. " & _
                    "If you would like to request an extension, please contact Stephanie Kutchinski at ext. 4686." & vbNewLine & _
                    theBook
            (Here is where is want to insert a carriage return and include the library book title found in column A)
            .Send
        End With
        
        If wasOpen = False Then
            
            wb.Close True
        End If
        
        Application.ScreenUpdating = True
        Application.EnableEvents = True
        Set olApp = Nothing
        Set olMsg = Nothing
    End Sub

  3. #3
    Thanks for the quick reply! I made some minor tweeks and this worked great until I realized my original code and approach did not function properly after all.
    I discovered that when the library resource listed in column A became "OVERDUE" (shown in column H), multiple errors were occurring:

    1. Worksheet change event was triggered by ANY change and would send multiple emails for every instance of "OVERDUE", including those which had already received an overdue notice.
    2. All emails referenced the book details found in row 2 only.
    3. No emails were triggered if row 2 (the first row of range) was NOT overdue.

    It looks like I need an entirely new code to accomplish what I need. Right now, the worksheet acccomplishes the following:

    -When someone checks out a title found in column "A", the date is entered into column "F" of the relevant row and their email addy into column "I"
    -Then cell formulas in column "G" populate its cell automatically with the due date for two weeks later.
    -If the date in column "G" becomes past due, cell formulas in column "H" then populate its cells with "OVERDUE"

    At this point, what I was trying to accomplish was the automatice generation of an email to the borrower when their book becaume overdue. Below is what I have thus far. It's your coding from above with some minor changes. Any guidance as to how to tackle this project would be wonderful! If you need additional info or the worksheet itself to view I'm happy to send.

    CODE

    Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("H2").Value = "OVERDUE" Then
    Call sendBook(Range("I2").Text, Range("A2").Text, Range("E2").Text)


    End If
    End Sub
    CODE

    Sub sendBook(ByVal theAddy As String, ByVal theBook As String, ByVal theType As String)
    Dim wb As Workbook, wasOpen As Boolean
    Dim olApp As Object, olMsg As Object

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    On Error Resume Next
    wasOpen = True
    Workbooks(Sheet1).Activate
    If Err <> 0 Then

    Set wb = Workbooks.Open("C:\Users\op936sp\Documents\ADMIN\Library\Library Check In-Check Out.xlsx")
    wasOpen = False
    Err.Clear
    Else

    Set wb = ActiveWorkbook
    wb.Save
    End If

    Set olApp = CreateObject("Outlook.Application")
    Set olMsg = olApp.CreateItem(0)
    With olMsg

    .To = theAddy
    .Subject = "Overdue library " & theType & " notice"
    .HTMLbody = "Please return the overdue " & theType & " listed below to MS 56. If you would like to request an extension, please contact Stephanie Kutchinski at ext. 4686." & "<P><B><I>" & theBook & "</P></B></I>"
    .Send
    End With
    If wasOpen = False Then
    wb.Close True
    End If
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Set olApp = Nothing
    Set olMsg = Nothing
    End Sub

  4. #4
    I am afraid I do not understand what the problem is. I know what you are saying is wrong, but I do not see how that is happening.

  5. #5
    Quote Originally Posted by Bob Phillips View Post
    I am afraid I do not understand what the problem is. I know what you are saying is wrong, but I do not see how that is happening.
    When I initially tested the document, I didn't quite get what the problem was either becuase I was only using my email address. After changing that method and using multiple addresses throughout the document I was finally able to determine that the only emails being sent were to the first record only in H2. If it helps make sense, I've attached a pared down version of my spreadsheet here for review. The original contains 700+ titles that I track and was too large to attach.
    Library Log - MASTER Test.xlsm

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •