Populate the selected cells value for command button email

0

I have a training tracker in excel and I have a command button that will automatically open outlook and create the email reminder for expired training when pressed.  However, I am having an issue with it auto-populating the contents of the column for which the email addresses are listed. My goal is to use the filter function to filter by expired dates and then drag select to highlight all the email address I want to send the reminder to, then click the command button and it pulls up 1 email with all the selected cell's addresses in the TO box. When I drag to select, it only populates the first cell I touch before dragging into the TO box in outlook. A bonus but not a necessity would be if I could get this email to automatically attach a PDF document to it :) I am very new to this and actually copied this command button email code from someone else. Thank you very much for your help! This is the code:

Private Sub CommandButton1_Click()
'Updated by Extendoffice 2017/9/14
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    On Error Resume Next
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hello Sir/Ma'am," & vbNewLine & vbNewLine & _
              "You are receiving this email because your Government Travel Card Statement of Understanding and Training Certificate has or is about to expire.  The Training is required to be accomplished every three years and the Statement of Understanding resigned every three years and upon arrival at each new duty station." & vbNewLine & vbNewLine & _
              "Attached is the SoU that needs to be completed and signed by both the member and the member's supervisor. Please follow the below steps to access the Training:" & vbNewLine & vbNewLine & _
              "-Go to the TRAX website:   https://www.defensetravel.dod.mil/Passport/bin/Passport.html" & vbNewLine & vbNewLine & _
              "-CAC Login" & vbNewLine & vbNewLine & _
              "-Click the Training Icon at the top of the page" & vbNewLine & vbNewLine & _
              "-Select the View All radio button" & vbNewLine & vbNewLine & _
              "-Select Launch for the Programs & Policies - Travel Card Program (Travel Card 101) [Mandatory] Course" & vbNewLine & vbNewLine & _
              "-When completed, format certificate to Landscape and save as PDF" & vbNewLine & vbNewLine & _
              "Once both documents are complete, respond to this email with both documents attached so we can update our records.  This is mandatory and failure to accomplish can result in temporary closure of your GTC account." & vbNewLine & vbNewLine & _
              "If you have any questions or concerns please let me know." & vbNewLine & vbNewLine & _
              "Thank you"
                  On Error Resume Next
    With xOutMail
        .To = Selection.Value
        .CC = ""
        .BCC = ""
        .Subject = "GTC SoU & Training Certificate Expired"
        .Body = xMailBody
        .Display   'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub
Answer
Discuss

Answers

0
Selected Answer

Please try this solution.

Private Sub CommandButton1_Click()
'Updated by Extendoffice 2017/9/14
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String

'    On Error Resume Next       ' hiding the crash won't prevent it
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hello Sir/Ma'am," & vbNewLine & vbNewLine & _
              "You are receiving this email because your Government Travel Card Statement of Understanding and Training Certificate has or is about to expire.  The Training is required to be accomplished every three years and the Statement of Understanding resigned every three years and upon arrival at each new duty station." & vbNewLine & vbNewLine & _
              "Attached is the SoU that needs to be completed and signed by both the member and the member's supervisor. Please follow the below steps to access the Training:" & vbNewLine & vbNewLine & _
              "-Go to the TRAX website:   https://www.defensetravel.dod.mil/Passport/bin/Passport.html" & vbNewLine & vbNewLine & _
              "-CAC Login" & vbNewLine & vbNewLine & _
              "-Click the Training Icon at the top of the page" & vbNewLine & vbNewLine & _
              "-Select the View All radio button" & vbNewLine & vbNewLine & _
              "-Select Launch for the Programs & Policies - Travel Card Program (Travel Card 101) [Mandatory] Course" & vbNewLine & vbNewLine & _
              "-When completed, format certificate to Landscape and save as PDF" & vbNewLine & vbNewLine & _
              "Once both documents are complete, respond to this email with both documents attached so we can update our records.  This is mandatory and failure to accomplish can result in temporary closure of your GTC account." & vbNewLine & vbNewLine & _
              "If you have any questions or concerns please let me know." & vbNewLine & vbNewLine & _
              "Thank you"
'    On Error Resume Next       ' hiding the crash won't prevent it

    With xOutMail
        .To = Recipients(Selection)
        .CC = ""
        .BCC = ""
        .Subject = "GTC SoU & Training Certificate Expired"
        .Body = xMailBody
        .Display   'or use .Send
    End With

    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

Private Function Recipients(SelRng As Range) As String
    ' 19 Sep 2019

    Dim Fun As String
    Dim Cell As Range
    Dim Tmp As String

    On Error Resume Next        ' return a blank string if nothing was selected
    For Each Cell In SelRng.Columns(1).SpecialCells(xlCellTypeVisible)
        Tmp = Cell.Value
        ' test if the cell appears to contain an email address
        If InStr(Tmp, "@") Then
            If Len(Fun) Then Fun = Fun & ";"
            Fun = Fun & Tmp
        End If
    Next Cell

    Recipients = Fun
End Function

Selection.Value can be a string or an array, depending upon what you selected. If you selected more than one email address the array must be converted to a string which separates the recipients' addresses with semicolons. The function Recipients I added to your code does this. The string it returns is then assigned to the mail's To field.

I took exception to the liberal use of On Error Resume Next in your code. Essentially, if the email can't be created for whatever reason your code will silently do nothing. In such a case one tends to look at the screen in unbelieving stupidity and press the button again and again. Removing the On Error Resume Next will cause the program to crash with some kind of error message. Whether or not that is more helpful is debatable but I think it's better than a blank screen. Reinstate the two instances of the offending code if you so prefer. The better way would be to trap the errors and issue an informative message. But that is the subject of another question.

The same applies to your wish to attach a document to your mail. The answer has no room here.

Discuss

Discussion

Hi Variatus, thank you so much for explaining that! It does work and does exactly what I need it to, but is it normal for the excel to freeze after pushing the Command Button before it ultimately brings up the email draft? I wish I could attach a screenshot of what I'm talking about. The whole excel freezes and the command button then appears mulitple times through out the page (nothing is clickable) the top menu bar says (not responding) then after about 3-5 seconds, the email draft pops up and the excel returns to normal.  Additionally, I just copied and pasted the code you provided, shall I remove the '  On Error Resume Next  line and only have ' hiding the crash won't prevent it listed? I've tried both ways and the "freeze/glitch" still happens. I am not sure if they are related or not. Thanks again!
Tori M (rep: 2) Sep 18, '19 at 2:49 pm
I believe the delay and not responding are normal when excel has to interact with other applications. It may vary depending on whether outlook is running or not. You can see this by seeing how long outlook takes to start when you start it.
k1w1sm (rep: 197) Sep 18, '19 at 3:05 pm
k1 has explained the reason for the "freeze". That can be avoided if Outlook is already loaded when you run the macro, but your code creates its own new instance of Outlook every time. To use the instance which is already loaded, and create a new one only if there isn't one already, is the subject of another question. Please mark this answer as "Accepted" to close the thread.
Variatus (rep: 3828) Sep 18, '19 at 11:01 pm
Thank you both for your response. Yes outlook was already open and running every time I used the excel button, but like you said it's just something we can definitely deal with! Thanks again i'll close the discussion now.
Tori M (rep: 2) Sep 19, '19 at 7:50 am
Add to Discussion


Answer the Question

You must create an account to use the forum. Create an Account or Login