Получение этого кода для регистрации исходящих писем - PullRequest
Новая
       10

Получение этого кода для регистрации исходящих писем

0 голосов
/ 23 мая 2019

Я использовал приведенный ниже код для входа в систему электронных писем на Outlook 2016 и 360. Но есть пара проблем, которые мне не удалось решить. Мне бы хотелось, чтобы он регистрировал электронные письма, отправленные пользователями (SMPT-адрес), а также помещал идентификатор на лист, который я использую, показывая, является ли это исходящее или входящее электронное письмо. Кроме того, в какой-то момент макрос останавливает приложение Outlook на пару секунд, которые могут раздражать. , Также, наконец, было бы возможно, если бы макрос мог каждый день отправлять адрес электронной почты в файл Messagelog.xlsx. 


Public WithEvents objMails As Outlook.Items

Private Sub Application_Startup()
    Set objMails = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub objMails_ItemAdd(ByVal Item As Object)
    Dim objMail As Outlook.MailItem
    Dim strExcelFile As String
    Dim objExcelApp As Excel.Application
    Dim objExcelWorkBook As Excel.Workbook
    Dim objExcelWorkSheet As Excel.Worksheet
    Dim nNextEmptyRow As Integer
    Dim strColumnB As String
    Dim strColumnC As String
    Dim strColumnD As String
    Dim strColumnE As String

    If Item.Class = olMail Then
       Set objMail = Item
    End If

    'Specify the Excel file which you want to auto export the email list
    'You can change it as per your case
    strExcelFile = "C:\ETracker\MessageLog.xlsx"

    'Get Access to the Excel file
    On Error Resume Next
    Set objExcelApp = GetObject(, "Excel.Application")
    If Error <> 0 Then
       Set objExcelApp = CreateObject("Excel.Application")
    End If
    Set objExcelWorkBook = objExcelApp.Workbooks.Open(strExcelFile)
    Set objExcelWorkSheet = objExcelWorkBook.Sheets("Received")

    'Get the next empty row in the Excel worksheet
    nNextEmptyRow = objExcelWorkSheet.Range("B" & objExcelWorkSheet.Rows.Count).End(xlUp).Row + 1

    'Specify the corresponding values in the different columns
    strColumnB = objMail.SenderName
    strColumnC = objMail.SenderEmailAddress
    strColumnD = objMail.Subject
    strColumnE = objMail.ReceivedTime

    'Add the vaules into the columns
    objExcelWorkSheet.Range("A" & nNextEmptyRow) = nNextEmptyRow - 1
    objExcelWorkSheet.Range("B" & nNextEmptyRow) = strColumnB
    objExcelWorkSheet.Range("C" & nNextEmptyRow) = strColumnC
    objExcelWorkSheet.Range("D" & nNextEmptyRow) = strColumnD
    objExcelWorkSheet.Range("E" & nNextEmptyRow) = strColumnE

    'Fit the columns from A to E
    objExcelWorkSheet.Columns("A:E").AutoFit

    'Save the changes and close the Excel file
    objExcelWorkBook.Close SaveChanges:=True
End Sub

Я хотел бы иметь одного Excel с зарегистрированной информацией, показывающей, кто отправил электронное письмо, получатели, тему и отметку времени, отметку о входящем / исходящем сообщении

1 Ответ

0 голосов
/ 24 мая 2019

Если вы хотите регистрировать отправленные письма, перехватите событие Application.ItemSend. Однако для автоматической отправки писем в определенное время дня вы очень ограничены макросами VBA. Один из способов - использовать повторяющуюся задачу со временем напоминания, искать эту конкретную задачу в событии Application.Reminder и запускать макрос в это время. В противном случае вам придется создать это как надстройку COM и использовать какой-либо компонент таймера .NET.

...