В любом случае, чтобы экспортировать электронную почту в папку, включая вложения?

У меня есть система, которую я создал сверхурочно, которая помещает данные электронной почты в электронную таблицу Excel. Это здорово, но то, что я также хотел бы сделать после запуска, — это извлечь электронные письма, включая любые вложения из Outlook, в новую папку на моем ПК с Windows.

Когда электронная почта находится в электронной таблице Excel, а затем электронная почта и вложения извлекаются в папку на моем ПК, я хотел бы, чтобы уникальный идентификатор (возможно, дата электронной почты или просто случайное число) был добавлен к электронной почте, которая затем автоматически отправит адрес ссылки обратно в электронную таблицу рядом с извлеченным электронным письмом, а также добавит уникальный идентификатор в электронную таблицу. Звучит немного запутанно, и я надеюсь, что это имеет смысл (Возможно ли это?)

Люди будут отвечать на электронные письма, и я также хотел бы, чтобы в ответных электронных письмах на оригинальное письмо (которое должно иметь уникальный идентификатор, указанный выше) использовался тот же идентификатор, который был указан в исходном электронном письме. Еще раз извините, если это звучит запутанно, с удовольствием расскажу подробнее, если нужно.

Вид новичок в подобных вещах, поэтому любая помощь будет отличной.

Вот код, который я написал до сих пор;

Sub Download_Outlook_Mail_To_Excel()
    'Add Tools->References->"Microsoft Outlook nn.n Object Library"
    'nn.n varies as per our Outlook Installation
    Dim Folder As Outlook.MAPIFolder
    Dim sFolders As Outlook.MAPIFolder
    Dim iRow As Integer, oRow As Integer
    Dim MailBoxName As String, Pst_Folder_Name  As String

    'Mailbox or PST Main Folder Name (As how it is displayed in your Outlook Session)
    MailBoxName = "[email protected]"

    'Mailbox Folder or PST Folder Name (As how it is displayed in your Outlook Session)
    Pst_Folder_Name = "Inbox" 'Sample "Inbox" or "Sent Items"

    'To directly a Folder at a high level
    'Set Folder = Outlook.Session.Folders(MailBoxName).Folders(Pst_Folder_Name)

    'To access a main folder or a subfolder (level-1)
    For Each Folder In Outlook.Session.Folders(MailBoxName).Folders
        If VBA.UCase(Folder.Name) = VBA.UCase(Pst_Folder_Name) Then GoTo Label_Folder_Found
        For Each sFolders In Folder.Folders
            If VBA.UCase(sFolders.Name) = VBA.UCase(Pst_Folder_Name) Then
                Set Folder = sFolders
                GoTo Label_Folder_Found
            End If
        Next sFolders
    Next Folder

Label_Folder_Found:
     If Folder.Name = "" Then
        MsgBox "Invalid Data in Input"
        GoTo End_Lbl1:
    End If

    'Read Through each Mail and export the details to Excel for Email Archival
    ThisWorkbook.Sheets(1).Activate
    Folder.Items.Sort "Received"

    'Insert Column Headers
    ThisWorkbook.Sheets(1).Cells(1, 1) = "Sender"
    ThisWorkbook.Sheets(1).Cells(1, 2) = "Subject"
    ThisWorkbook.Sheets(1).Cells(1, 3) = "Date"
    'ThisWorkbook.Sheets(1).Cells(1, 4) = "Size"
    ThisWorkbook.Sheets(1).Cells(1, 5) = "EmailID"
    ThisWorkbook.Sheets(1).Cells(1, 6) = "Body"

    'Export eMail Data from PST Folder
    oRow = 1
    For iRow = 1 To Folder.Items.Count
        'If condition to import mails received in last 60 days
        'To import all emails, comment or remove this IF condition
        'If VBA.DateValue(VBA.Now) - VBA.DateValue(Folder.Items.Item(iRow).ReceivedTime) <= 60 Then
           oRow = oRow + 1
           ThisWorkbook.Sheets(1).Cells(oRow, 1).Select
           ThisWorkbook.Sheets(1).Cells(oRow, 1) = Folder.Items.Item(iRow).SenderName
           ThisWorkbook.Sheets(1).Cells(oRow, 2) = Folder.Items.Item(iRow).Subject
           ThisWorkbook.Sheets(1).Cells(oRow, 3) = Folder.Items.Item(iRow).ReceivedTime
           'ThisWorkbook.Sheets(1).Cells(oRow, 4) = Folder.Items.Item(iRow).Size
           ThisWorkbook.Sheets(1).Cells(oRow, 5) = Folder.Items.Item(iRow).SenderEmailAddress
           ThisWorkbook.Sheets(1).Cells(oRow, 6) = Folder.Items.Item(iRow).Body
        'End If
    Next iRow
    MsgBox "Outlook Mails Extracted to Excel"
    Set Folder = Nothing
    Set sFolders = Nothing

End_Lbl1:
End Sub

outlook excel vba excel-2013
person neosegauk    schedule 15.08.2015    source источник

Ответы (1)


arrow_upward
1
arrow_downward

вместо цикла for вы можете сделать:

Dim msg As Outlook.MailItem 
...

For Each msg in Folder.Items

    'You can access here each message properties, like msg.attachments...
     ThisWorkbook.Sheets(1).Cells(oRow, 1) = msg.Attachments.Item(1).FileName
     ...
     msg.Attachments.Item(1).SaveAsFile "C:\...."

Next
person B Quesnel    schedule 15.08.2015
comment
Привет Би Кенель. Попробовал вышеупомянутое предложение и отредактировал мой код выше, чтобы показать это, но теперь я получаю Исключение ошибки автоматизации во время выполнения. - person neosegauk; 15.08.2015
comment
Я исправил то, что сказал выше :) - person neosegauk; 15.08.2015