Microsoft Office Forums - View Single Post

gmayor · 03-30-2019, 02:30 AM

You could use a script to log the time the messages arrive and who they are from using a two column Excel worksheet with a header row and the following code run from a rule that acts on all incoming messages. I have included a macro to test it with a selected message. You will need to create your own worksheet and change the workbook name as appropriate.

Code:

Option Explicit
Const strWorkBook As String = "C:\Path\EMailLog.xlsx"    '- two column worksheet (Sheet1) with header row

Sub TestCode()
Dim olMsg As MailItem
    On Error Resume Next
    Set olMsg = ActiveExplorer.Selection.Item(1)
    LogEMails olMsg
lbl_Exit:
    Exit Sub
End Sub

Sub LogEMails(olItem As MailItem)
Dim strAddress As String
Dim strDate As String
    strDate = olItem.ReceivedTime
    strAddress = olItem.SenderEmailAddress
    LogToExcel strWorkBook, strAddress, strDate
lbl_Exit:
    Exit Sub
End Sub

Private Function LogToExcel(strWorkBook As String, _
                            strAddress As String, _
                            strDate As String)


Dim ConnectionString As String
Dim strSQL As String
Dim CN As Object
    ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                       "Data Source=" & strWorkBook & ";" & _
                       "Extended Properties=""Excel 12.0 Xml;HDR=YES;"";"
    strSQL = "INSERT INTO [Sheet1$] VALUES('" & strDate & "', '" & strAddress & "')"
    Set CN = CreateObject("ADODB.Connection")
    Call CN.Open(ConnectionString)
    Call CN.Execute(strSQL, , 1 Or 128)
    CN.Close
    Set CN = Nothing
lbl_Exit:
    Exit Function
End Function