Retroactive link between outlook and vba

2019-09-23 17:31发布

I’m currently working on an access Vba program in order to automatically write mails to people. However we chose to still press ‘Send’ in Outlook manually (in case there are possible issues, so we can control the mail beforehand).

Is there a way to have a link in the other direction, as in, when pressing the Send button in Outlook, getting the email address of the person back in excel? (The goal would be to make a ‘history’ sheet in order to keep track of which mails were actually sent and to whom)

Thank you!

2条回答
贪生不怕死
2楼-- · 2019-09-23 18:16

Yes. A simple case is shown below. This is bare bones demonstrating the actions you requested.

Public variable, addressSent, holds the To address. A boolean test on mail sent (by @Rory) tests for the mail item having been sent and calls a function, by @Dwipayan Das, that opens a specified Excel file, and writes the addressSent to cell A1 in sheet1.

You can tinker with this to fit your purposes. E.g. Adapt the function to accept a file name as parameter.....

Taking a note from @ashleedawg's book: remember to include a xlApp.Quit line so Excel is not left hanging.

I believe your question wanted to go from Outlook to Excel so this is the application that you will have created that needs closing.

So in Outlook goes the following code:

Put this in a standard module:

Option Explicit
Public addressSent As String
Dim itmevt As New CMailItemEvents

Public Sub CreateNewMessage()

    Dim objMsg As MailItem

    Set objMsg = Application.CreateItem(olMailItem)

    Set itmevt.itm = objMsg

    With objMsg

        .Display
        .To = "somebody@mail.com"
        .Subject = "Blah"

        addressSent = .To

        .Send

    End With

End Sub

Public Function openExcel() As Boolean 'Adapted from @Dwipayan Das

    Dim xlApp As Object
    Dim sourceWB As Object
    Dim sourceWS As Object

    Set xlApp = CreateObject("Excel.Application")

    With xlApp

        .Visible = True
        .EnableEvents = False

    End With

    Dim strFile As String

    strFile = "C:\Users\User\Desktop\Delete.xlsb" 'Put your file path.

    Set sourceWB = xlApp.Workbooks.Open(strFile, , False, , , , , , , True)

    sourceWB.Activate

    sourceWB.Worksheets(1).Range("A1") = addressSent

End Function

Then in a class module called CMailItemEvents, code from @Rory, put the following:

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
      openExcel
   End If
End Sub

References:

  1. Check to see if an Outlook Email was sent from Excel VBA
  2. How can I use Outlook to send email to multiple recipients in Excel VBA
  3. How to open an excel file in Outlook vba code
  4. Create a new Outlook message using VBA
  5. Run code after item sent
查看更多
▲ chillily
3楼-- · 2019-09-23 18:16

Just a quick 'n dirty function that will run in Excel/Access/Word and returns the email address from the most recent item in the Sent Items folder (no error handling, etc):

Function LastSentEmailAddress() As String
'Requires reference: "Microsoft Outlook xx.x Object Library"

    Dim olApp As Outlook.Application, olMail As Object
    Set olApp = New Outlook.Application 'create Outlook object
    Set olMail = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail).Items.GetLast

    LastSentEmailAddress = olMail.Recipients(1).PropertyAccessor.GetProperty( _
            "http://schemas.microsoft.com/mapi/proptag/0x39FE001E") 'get email addy

    olApp.Quit 'close Outlook

End Function

A Note about working with Outlook objects from Excel:

When working with applications such as Excel it's important to make sure the application object is properly .Quit / .Close'd when finished with them, (and to Set all objects to Nothing), otherwise there's a risk of inadvertently having multiple instances running, which can lead to memory leaks, which leads to crashes and potential data loss.

To check if there is an existing instance of Outlook, use this function:

Function IsOutlookOpen()
'returns TRUE if Outlook is running

    Dim olApp As Outlook.Application

    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    On Error GoTo 0

    If olApp Is Nothing Then
        IsOutlookOpen= False
    Else
        IsOutlookOpen= True
    End If

End Function

(Source: Rob de Bruin)


More Information:

查看更多
登录 后发表回答