VBA to Check if Email Sent/Not Sent and Display Text+Date

Microsoft Excel 2010 - complete product...
July 26, 2018 at 05:32:52
Specs: Windows 7 x64, 2,4 GHz / 4 GB
I have a code to generate and display an email using some data in an excel sheet. The email is generated based on an initial range of cells, let's call it myRNG, selected via input box, from a single column (A). Of course, some other data is added to the email body (myRNG offset etc.), some attachments are added too, and then the email is displayed in order to check it before finally sending it.

Upon displaying the email I might decide to close it because some data is wrong and then generate it again after I correct the data in excel.

In the case I close it, after pressing the close button I would like some code to add "NOT SENT" to a range (let's say in column B), corresponding to my initial range of data (myRNG).

myRNG is A1:A3

EG: Case I close the email to correct errors:

        A          B          C          D          E
1    009123    NOT SENT
2    009331    NOT SENT
3    009509    NOT SENT
4    008326
5    008222
6    007119

In the case I send it instead of closing it (when column B cells are blank) or I send it after correcting data (when column B cells contain "NOT SENT") after pressing the send button the same range in column B should be completed/updated with "SENT" and in column C the date of sending the email should be added (today, but not as a formula of course).

EG: After I send the email:

        A          B          C          D          E
1    009123      SENT    25.07.2018     
2    009331      SENT    25.07.2018     
3    009509      SENT    25.07.2018     
4    008326
5    008222
6    007119

But, in the future I might want to resend the same email again, I would like the date to remain unmodified and columns D and E to be updated with RE-SENT (col D) and date when it was re-sent in column E.

EG: After I send the email again:

        A          B          C          D          E
1    009123      SENT    25.07.2018   RE-SENT   26.07.2018
2    009331      SENT    25.07.2018   RE-SENT   26.07.2018
3    009509      SENT    25.07.2018   RE-SENT   26.07.2018
4    008326
5    008222
6    007119

If I choose to send the email for the 3rd time, column E should be updated with the new date.

I hope this isn't very confusing, I tried to explain as best as possible.

I tried to find a way to display SENT/NOT SENT in column B upon sending/closing the email without sending, but I get stuck at using class modules and referring to them in my code. Simply nothing gets displayed. Dunno if I am allowed paste here the source (website) of the code I tried. I will add the code below, inside PRE tags.

It was based on the _Send event in the Outlook.MailItem class, for which I added Microsoft Outlook 15.0 Object Library as reference. The member on that website didn't give this detail, nor did he give much detail for me to work with, but his answer dates from 2010. I'm guessing there might be some compatibility issues since back then they were using Office 2007 and I'm using Office 2013.

I tried to step through that part of the code, but there are no errors and I have no clue what to do. The member didn't mention a range for BoolRange, or for DateRange.

This is entirely possible, using the _Send event in the Outlook.MailItem class.

The way I use it, I create a class called EMailWatcher, so when I create the email and do
 the .Display, I then create a new EMailWatcher object and tell it to watch that email for
 send, then report back when it happens.

Here's the class as I use it. Basically, I also optionally can set the BoolRange so that if 
the user sends the email, that Excel range gets updated with True. I can also have the
 class update an Excel range with the time the email is sent.

Public BoolRange As Range
Public DateRange As Range
Public WithEvents TheMail As Outlook.MailItem

Private Sub TheMail_Send(Cancel As Boolean)
    If Not BoolRange Is Nothing Then
        BoolRange.Value = True
    End If
    If Not DateRange Is Nothing Then
        DateRange.Value = Now()
    End If
End Sub

And here's how I use it:

With OutMail
    .To = addr
    .Subject = "CCAT eVSM Utilities License Code"
    .Body = "Message body"
    .Display
End With

Set CurrWatcher = New EmailWatcher
Set CurrWatcher.BoolRange = Range("B1")
Set CurrWatcher.TheMail = OutMail

message edited by Mrrrr


See More: VBA to Check if Email Sent/Not Sent and Display Text+Date

Reply ↓  Report •

#1
July 26, 2018 at 06:12:02
Look here, it is possible but you may need to change your code slightly.

How many Outlook email windows can appear at one time? if only one Window appears at a time this will be pretty easy, iv not done this with multiple windows at one time.

https://www.mrexcel.com/forum/excel...

message edited by AlwaysWillingToLearn


Reply ↓  Report •

#2
July 26, 2018 at 10:25:55
Read the entire Mr. Excel thread. There are errors in the code posted early in the thread.


message edited by DerbyDad03


Reply ↓  Report •

#3
July 27, 2018 at 00:08:59
Thanks for the answer. I remember trying that code too before asking here, right at the beginning, but I got a bit confused by their subsequent answers based on the code and didn't quite understand what I was supposed to do with the initial code to fix it. I still don't.

I'm only displaying an email at once and it will always be like that.

I have a long module building the email based on data in excel and inserting some data in word documents then generating PDFs to attach to the email. I ran it with CTRL+F8 until the Set OutMail line. Then I stepped through with F8 and after I F8 on the Set itmevt.itm line, it does the With OutMail part entirely up to the end of the module (I know because in the end I run a code to delete the PDFs and they're gone from the temporary folder and the email is displayed with everything attached. Everything disappears from the Locals window so I can't see any more values of variables, errors etc.

Below is the end part of my code:

        Set OutMail = OutApp.CreateItem(0)
        Set itmevt.itm = OutMail
            
        With OutMail
            .To = rngFacturi.Item(1, 1).Offset(, 8).Value
            .CC = rngFacturi.Item(1, 1).Offset(, 9).Value
            .Subject = "EMAIL SUBJECT"
            .HTMLBody = tmpBody & signature
                    
            strFile = Dir(strPath & "*.*")
    
            Do While Len(strFile) > 0
                .Attachments.Add strPath & strFile
                strFile = Dir
            Loop
    
                '.Send
                .Display
                
        End With

On Error GoTo 0

        Set OutMail = Nothing
    End If

deletePDFs

Here is the class module from MrExcel website which I added to a class module:

Option Explicit
Public WithEvents itm As Outlook.MailItem
Private Sub itm_Close(Cancel As Boolean)

   Dim blnSent As Boolean
   On Error Resume Next
   blnSent = itm.Sent
   If Err.Number = 0 Then
      Debug.Print "Not sent"
   Else
      ' do what you need to do <------ dunno if I should add something here (?), 
      'maybe a range where to display "NOT SENT"; but if this code is 
      'wrong... and since it skips through everything when I F8 through 
      'Set itmevt.itm = OutMail in my module I don't know what to make 
      'of it.
   End If
End Sub

I added the declaration at the top of my main module, like this:

Dim itmevt As New CMailItemEvents

Sub CreateQC()


Reply ↓  Report •

Related Solutions

#4
July 30, 2018 at 05:06:17
I've stumbled upon another topic on this matter, on stackoverflow, which is working in its basic form:
https://stackoverflow.com/questions...
The user says it would work for multiple emails, though I only need it for 1 email at a time.

I adapted those to work on my code, but "suddenly" the tmpBody building snippet from myArray (the one we talked about in my previous topic: https://www.computing.net/answers/o... is asking me to declare the nxtItem and tmpBody variables.

Here are the settings that worked for me - I only tried with 1 email at a time:

Declarations outside the main module:

Option Explicit
Public olApp As Outlook.Application
Public WatchEmails As New Collection

And the main module email snippet:

Set olApp = CreateObject("Outlook.Application")
Dim thisMail As New EMailWatcher
WatchEmails.Add thisMail

        strPath = "D:\PDF\"

        With thisMail.TheMail
            .To = myRange.Item(1, 1).Offset(, 8).Value
            .CC = myRange.Item(1, 1).Offset(, 9).Value
            .Subject = "Subject"
            .HTMLBody = tmpBody & signature
                    
            strFile = Dir(strPath & "*.*")
    
            Do While Len(strFile) > 0
                .Attachments.Add strPath & strFile
                strFile = Dir
            Loop
    
                '.Send
                .Display
                
        End With

Class module named EmailWatcher:

Option Explicit
Public WithEvents TheMail As Outlook.MailItem

Private Sub Class_Terminate()
   Debug.Print "Terminate " & Now()
End Sub
    
Private Sub TheMail_Close(Cancel As Boolean)
   Debug.Print "not sent " & Now()
End Sub
    
Private Sub TheMail_Send(Cancel As Boolean)
   Debug.Print "Send " & Now()  
   Worksheets(1).Range("R1") = Now()    '<----- THIS LINE
End Sub
    
Private Sub Class_Initialize()
   Debug.Print "Initialize " & Now()
   Set TheMail = olApp.CreateItem(0)    
End Sub

I tried to add a message when email is closed and wasn't able to.
I mean adding a similar line as THIS LINE from TheMail_Send sub to TheMail_Close sub. It would simply "print" both cells, even if I would send the email. Could you please help?


Reply ↓  Report •

#5
July 30, 2018 at 06:18:50
re: but "suddenly" the tmpBody building snippet ... is asking me to declare the nxtItem and tmpBody variables.

Option Explicit forces the declaration all variables. In the strictest terms, it's not a bad thing to use all the time because it can catch variable related errors before anything bad happens.

https://www.excel-easy.com/vba/exam...

How To Post Data or Code ---> Click Here Before Posting Data or VBA Code


Reply ↓  Report •

#6
July 31, 2018 at 07:07:24
For the code in the post above, which inserts send date and time in a cell when Send button is pressed. I tried to add a message when email is closed in the Sub TheMail_Close.

Private Sub TheMail_Close(Cancel As Boolean)
   Debug.Print "not sent " & Now()
   Worksheets(1).Range("S1") = "NOT SENT"
End Sub
    
Private Sub TheMail_Send(Cancel As Boolean)
   Debug.Print "Send " & Now()  
   Worksheets(1).Range("R1") = Now()
End Sub

When mail is sent, the snippet above (part of the code in my previous post) adds =Now() to R1 and adds "NOT SENT" to S1. I repeat: when email IS SENT.

It should not run TheMail_Close but for some reason it does. Please see my full code above (note that in the code from that post I forgot to add the NOT SENT line in Sub TheMail_Close.

Am I doing something wrong?


Reply ↓  Report •

#7
August 3, 2018 at 05:29:04
Can you post your entire code please, it would be easier for us to replicate your workbook that way.

Reply ↓  Report •

#8
August 28, 2018 at 06:41:53
Sorry for the long time it took to answer, been on holidays.

It's a long code... but here goes:

First the CLASS MODULE called EmailWatcher:

Option Explicit
Public WithEvents TheMail As Outlook.MailItem

Private Sub Class_Terminate()
Debug.Print "Terminate " & Now()
End Sub
    
Private Sub TheMail_Close(Cancel As Boolean)
Debug.Print "not sent"
End Sub

Private Sub TheMail_Send(Cancel As Boolean)
Debug.Print "SENT " & Now()
    
setInvoices

For Each invoiceNo In rngInvoices

    If invoiceNo.Offset(, 4).Value = "" And invoiceNo.Offset(, 11) * invoiceNo.Offset(, 13) <> 0 Then
        invoiceNo.Offset(, 4).Value = Now()
        invoiceNo.Offset(, 5).Value = "Email sent"
        
        Else
            If invoiceNo.Offset(, 4).Value = "" And invoiceNo.Offset(, 11) = 1 And invoiceNo.Offset(, 13) = 0 Then
                invoiceNo.Offset(, 4).Value = Now()
                invoiceNo.Offset(, 5).Value = "Email sent"
                
                Else
                    If invoiceNo.Offset(, 4).Value <> "" Then
                        invoiceNo.Offset(, 5).Value = "re-sent in " & Now()
                        
                        Else
                            If invoiceNo.Offset(, 11) = 0 Then
                                invoiceNo.Offset(, 5).Value = "no DoP / DoC"
                            End If
                    End If
            End If
    End If
    
Next invoiceNo

    End Sub
    
Private Sub Class_Initialize()
Debug.Print "Initialize " & Now()

    Set TheMail = olApp.CreateItem(0)
    
End Sub

Now the MAIN CODE:

Option Explicit
Public olApp As Outlook.Application
Public WatchEmails As New Collection

' ############ GLOBAL VARIABLES TO USE ALSO IN EMailWatcher CLASS MODULE
Public rngInvoicesBox As Range
Public rngInvoices As Range
Public invoiceNo As Object

Sub setInvoicesBox() 
        Set rngInvoicesBox = Application.InputBox(prompt:="Select cells that contain invoice numbers " & _
                                                         "(it can be one or multiple cells):", Type:=8)
        If rngInvoicesBox Is Nothing Then
            Exit Sub
        End If
End Sub

Sub setInvoices()
        Set rngInvoices = rngInvoicesBox
End Sub
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Sub CreatePDFdop()

Application.ScreenUpdating = False

Dim invoice As String
Dim invoiceDate As String
Dim client As String
Dim document As String
Dim n As String

    On Error Resume Next
    
' ############ EXECUTE THE FOLLOWING SUBS (codes above this sub)
    setInvoicesBox
    setInvoices
    
        If rngInvoices Is Nothing Then
            GoTo EndSub
        End If

        n = 0

    For Each invoiceNo In rngInvoices
        n = n + 1
    
        ' invoiceNo.Offset(, 11) is helper column to check if in col. F is written the type of declaration of _
        performance, displays 0 if the cell is empty or if it contains "no DOP"
        ' invoiceNo.Offset(, 13) is helper column to check if on the same invoice there are multiple types of _
        declarations and displays 1 for the first occurence and 0 for the following occurences - this column uses _
        another column (Offset(, 12) in which are concatenated values in col. (invoice no) and col F (declaration type)

        If Not invoiceNo Is Nothing And Not invoiceNo.Offset(, 11) * invoiceNo.Offset(, 13) = 0 Then

' ############ OPEN WORD FILES, INSERT EXCEL DATA, EXPORT WORD FILES AS PDF AND CLOSE THEM WITHOUT SAVING

Dim objWord As Object
        Set objWord = CreateObject("Word.Application")
            document = invoiceNo.Offset(, 10).Value 
            objWord.Visible = True
            
            objWord.Documents.Open document
    
                invoice = invoiceNo.Value
                invoiceDate = invoiceNo.Offset(, -3).Value
                client = invoiceNo.Offset(, -2).Value

                UpdateBookmark "Text1", invoice, objWord.ActiveDocument, False 'True
                UpdateBookmark "Text2", invoiceDate, objWord.ActiveDocument, False 'True
                UpdateBookmark "Text3", client, objWord.ActiveDocument, False 'True
                
             objWord.ActiveDocument.ExportAsFixedFormat _
                                    OutputFileName:="D:\PDF\" & invoice & "_DoP" & n & ".pdf", _
                                    ExportFormat:=wdExportFormatPDF, _
                                    OptimizeFor:=wdExportOptimizeForOnScreen, _
                                    IncludeDocProps:=False, KeepIRM:=False, _
                                    CreateBookmarks:=wdExportCreateNoBookmarks, _
                                    DocStructureTags:=False, _
                                    OpenAfterExport:=False, _
                                    BitmapMissingFonts:=False, _
                                    UseISO19005_1:=False
            objWord.ActiveDocument.Close _
                                    SaveChanges:=wdDoNotSaveChanges
            objWord.Quit
        Set objWord = Nothing
    
        Else: n = n - 1
        End If

    Next invoiceNo

' ############ CREATE COLLECTION WITH MATERIALS THAT HAVE DECLARATION OF PERFORMANCE

Dim newCol As New Collection
Dim c As Range

For Each c In rngInvoices
    If c.Offset(, 3).Value <> "" And c.Offset(, 3).Value <> "no DoP" Then
        newCol.Add c
    End If
Next

MailSend:
Dim strPath, strFile As String
Dim myArray As Variant
Dim counter As Long
Dim myDict As Object
Dim nxtItem As Long
Dim tmpBody As String

' MAKE ARRAY FROM COLLECTION
If newCol.Count > 0 Then
    myArray = colToArray(newCol)
End If

        strPath = "D:\PDF\"

    Set myDict = CreateObject("Scripting.Dictionary")
        myDict.CompareMode = vbTextCompare

    For counter = 0 To UBound(myArray)
        myDict.Item(myArray(counter)) = myArray(counter)
    Next
    
        myArray = myDict.Items
        
        For nxtItem = 0 To UBound(myArray)
            tmpBody = tmpBody & "

</p>- invoice no. " & myArray(nxtItem) & vbNewLine & vbNewLine
        Next
    
If olApp Is Nothing Then Set olApp = CreateObject("Outlook.Application")
    
        tmpBody = "Hello,"
                                    vbNewLine & vbNewLine & _
                  "Attached we send you the declaration/s of performance/conformity for:" & vbNewLine & _
        tmpBody
    
' ############ OUTLOOK SIGNATURE
Dim signature As String

    signature = "SOMETHING"
    
' ############ CREATE EMAIL BODY, ATTACH FILES AND DISPLAY EMAIL

    If rngInvoices.Item(1, 1).Offset(, 8).Value = "" Then
        MsgBox "Email adress missing or column L no longer contains emails!
        GoTo EndSub
    End If
    
    If rngInvoices.Item(1, 1).Offset(, 8).Value Like "?*@?*.?*" Then

    Dim thisMail As New EMailWatcher
    WatchEmails.Add thisMail
            
        With thisMail.TheMail
            .To = rngInvoices.Item(1, 1).Offset(, 8).Value
            .CC = rngInvoices.Item(1, 1).Offset(, 9).Value
            .Subject = "BLA BLA BLA"
            .HTMLBody = tmpBody & signature
                    
            strFile = Dir(strPath & "*.*")
    
            Do While Len(strFile) > 0
                .Attachments.Add strPath & strFile
                strFile = Dir
            Loop
                '.Send
                .Display True
        End With

    On Error GoTo 0

    End If

' ############ DELETE PDFS AFTER DISPLAYING EMAIL
deletePDFs

EndSub:
Exit Sub

Application.ScreenUpdating = True

End Sub

' ############ UPDATE BOOKMARKS IN WORD FILE
Sub UpdateBookmark(BookmarkToUpdate As String, TextToUse As String, wDoc As Word.document, Optional bReplace As Boolean)

    Dim BMRange As Word.Range
    Dim sTest As String

    With wDoc
        Set BMRange = .Bookmarks(BookmarkToUpdate).Range

        sTest = BMRange.Text

        If sTest = "" Or bReplace Then
            BMRange.Text = TextToUse
        Else
            BMRange.Text = sTest & vbCr & TextToUse
        End If

        .Bookmarks.Add BookmarkToUpdate, BMRange

    End With

End Sub

' ############ DELETE PDFS AFTER DISPLAYING EMAIL
Sub deletePDFs()

Dim tempFile As String

    tempFile = "D:\PDF\*.*"

    If Len(Dir$(tempFile)) > 0 Then
        Kill tempFile
    End If

End Sub

' ############ MAKE ARRAY FROM COLLECTION
Function colToArray(c As Collection) As Variant()
    Dim a() As Variant: ReDim a(0 To c.Count - 1)
    Dim j As Integer
    For j = 1 To c.Count
        a(j - 1) = c.Item(j)
    Next
    colToArray = a
End Function


Reply ↓  Report •

#9
November 19, 2018 at 04:56:32
Sorry to bump this, but does anyone have any solution for this?

I repeat, now it's only checking if email sent and displaying message.
For not sent email (cancel send) there is no message displayed (blank) - this is the part I would like to add in the code above.


Reply ↓  Report •

Ask Question