Загрузить приложение из Outlook и Открыть в Excel

Я пытаюсь загрузить, а затем открыть вложение электронной таблицы Excel в электронном письме Outlook, используя VBA в Excel. Как я могу:

Загрузите одно и только вложение из первого электронного письма (новейшего сообщения электронной почты) в папку входящих сообщений Outlook.
Сохранить вложение в файл с указанным путем (например: "C:..." )
Переименуйте имя вложения с помощью: текущей даты + предыдущего имени файла
Сохранить электронную почту в другой папке с помощью пути, такого как "C:..."
Отметьте письмо в Outlook как "прочитанное"
Откройте приложение Excel в Excel

Я также хочу сохранить следующее как отдельные строки, назначенные отдельным переменным:

Адрес электронной почты отправителя
Дата получения
Дата отправки
Тема
Сообщение электронной почты

хотя это может быть лучше спросить в отдельном вопросе/искать его самостоятельно.

Код, который у меня есть в настоящее время, находится на других форумах в Интернете и, вероятно, не очень помогает. Тем не менее, вот несколько бит и частей, над которыми я работал:

Sub SaveAttachments()
    Dim olFolder As Outlook.MAPIFolder
    Dim att As Outlook.Attachment
    Dim strFilePath As String
    Dim fsSaveFolder As String

    fsSaveFolder = "C:\test\"

    strFilePath = "C:\temp\"

    Set olFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

    For Each msg In olFolder.Items
        While msg.Attachments.Count > 0
            bflag = False
            If Right$(msg.Attachments(1).Filename, 3) = "msg" Then
                bflag = True
                msg.Attachments(1).SaveAsFile strFilePath & strTmpMsg
                Set msg2 = Application.CreateItemFromTemplate(strFilePath & strTmpMsg)
            End If
            sSavePathFS = fsSaveFolder & msg2.Attachments(1).Filename


    End If
End Sub

Ответ 1

Я могу дать вам полный код за один раз, но это не поможет вам извлечь уроки из него;) Итак, давайте разберем ваши запросы, и тогда мы будем их обрабатывать 1 к 1. Это будет очень длинный пост, так что наберитесь терпения: )

Всего 5 частей, которые будут охватывать все 7 (да 7, а не 6) баллов, поэтому вам не нужно создавать новый вопрос для своего 7-го балла.

ЧАСТЬ - 1

Создание подключения к Outlook
Проверка наличия непрочитанного электронного письма
Получение таких деталей, как Sender email Address, Date received, Date Sent, Subject, The message of the email

Смотрите этот пример кода. Я связываюсь с Outlook из Excel, а затем проверяю, есть ли непрочитанные элементы, и, если они есть, я получаю соответствующие данные.

Const olFolderInbox As Integer = 6

Sub ExtractFirstUnreadEmailDetails()
    Dim oOlAp As Object, oOlns As Object, oOlInb As Object
    Dim oOlItm As Object

    '~~> Outlook Variables for email
    Dim eSender As String, dtRecvd As String, dtSent As String
    Dim sSubj As String, sMsg As String

    '~~> Get Outlook instance
    Set oOlAp = GetObject(, "Outlook.application")
    Set oOlns = oOlAp.GetNamespace("MAPI")
    Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)

    '~~> Check if there are any actual unread emails
    If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
        MsgBox "NO Unread Email In Inbox"
        Exit Sub
    End If

    '~~> Store the relevant info in the variables
    For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
        eSender = oOlItm.SenderEmailAddress
        dtRecvd = oOlItm.ReceivedTime
        dtSent = oOlItm.CreationTime
        sSubj = oOlItm.Subject
        sMsg = oOlItm.Body
        Exit For
    Next

    Debug.Print eSender
    Debug.Print dtRecvd
    Debug.Print dtSent
    Debug.Print sSubj
    Debug.Print sMsg
End Sub

Так что позаботьтесь о своем запросе, в котором говорится о сохранении деталей в переменных.

ЧАСТЬ - 2

Теперь перейдем к следующему запросу

Загрузите одно-единственное вложение из первого письма (самого нового) в папку входящих сообщений Outlook
Сохраните вложение в файле с указанным путем (например, "C:...")
Переименуйте имя вложения с: текущая дата + предыдущее имя файла

Смотрите этот пример кода. Я снова связываюсь с Outlook из Excel, затем проверяю, есть ли непрочитанные элементы, и, если они есть, я дополнительно проверяю, есть ли у него вложение и загружает ли оно его в соответствующую папку.

Const olFolderInbox As Integer = 6
'~~> Path for the attachment
Const AttachmentPath As String = "C:\"

Sub DownloadAttachmentFirstUnreadEmail()
    Dim oOlAp As Object, oOlns As Object, oOlInb As Object
    Dim oOlItm As Object, oOlAtch As Object

    '~~> New File Name for the attachment
    Dim NewFileName As String
    NewFileName = AttachmentPath & Format(Date, "DD-MM-YYYY") & "-"

    '~~> Get Outlook instance
    Set oOlAp = GetObject(, "Outlook.application")
    Set oOlns = oOlAp.GetNamespace("MAPI")
    Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)

    '~~> Check if there are any actual unread emails
    If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
        MsgBox "NO Unread Email In Inbox"
        Exit Sub
    End If

    '~~> Extract the attachment from the 1st unread email
    For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
        '~~> Check if the email actually has an attachment
        If oOlItm.Attachments.Count <> 0 Then
            For Each oOlAtch In oOlItm.Attachments
                '~~> Download the attachment
                oOlAtch.SaveAsFile NewFileName & oOlAtch.Filename
                Exit For
            Next
        Else
            MsgBox "The First item does not have an attachment"
        End If
        Exit For
    Next
 End Sub

ЧАСТЬ - 3

Переходя к следующему запросу

Сохраните письмо в другой папке с путем, например, "C:..."

Смотрите этот пример кода. Это сохранить письмо, чтобы сказать C: \

Const olFolderInbox As Integer = 6
'~~> Path + Filename of the email for saving
Const sEmail As String = "C:\ExportedEmail.msg"

Sub SaveFirstUnreadEmail()
    Dim oOlAp As Object, oOlns As Object, oOlInb As Object
    Dim oOlItm As Object, oOlAtch As Object

    '~~> Get Outlook instance
    Set oOlAp = GetObject(, "Outlook.application")
    Set oOlns = oOlAp.GetNamespace("MAPI")
    Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)

    '~~> Check if there are any actual unread emails
    If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
        MsgBox "NO Unread Email In Inbox"
        Exit Sub
    End If

    '~~> Save the 1st unread email
    For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
        oOlItm.SaveAs sEmail, 3
        Exit For
    Next
End Sub

ЧАСТЬ - 4

Переходя к следующему запросу

Пометьте письмо в Outlook как "прочитанное"

Смотрите этот пример кода. Это пометит письмо как read.

Const olFolderInbox As Integer = 6

Sub MarkAsUnread()
    Dim oOlAp As Object, oOlns As Object, oOlInb As Object
    Dim oOlItm As Object, oOlAtch As Object

    '~~> Get Outlook instance
    Set oOlAp = GetObject(, "Outlook.application")
    Set oOlns = oOlAp.GetNamespace("MAPI")
    Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)

    '~~> Check if there are any actual unread emails
    If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
        MsgBox "NO Unread Email In Inbox"
        Exit Sub
    End If

    '~~> Mark 1st unread email as read
    For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
        oOlItm.UnRead = False
        DoEvents
        oOlItm.Save
        Exit For
    Next
 End Sub

ЧАСТЬ - 5

Переходя к следующему запросу

Откройте приложение Excel в Excel

как только вы загрузили файл/вложение, как показано выше, используйте этот путь в приведенном ниже коде, чтобы открыть файл.

Sub OpenExcelFile()
    Dim wb As Workbook

    '~~> FilePath is the file that we earlier downloaded
    Set wb = Workbooks.Open(FilePath)
End Sub

Я преобразовал этот пост в несколько постов в блоге (с дополнительными пояснениями), к которым можно обратиться через пункты 15, 16 и 17 в vba-excel

Ответ 2

(Excel vba)

Спасибо Sid:) за ваш код (украден ваш код).. У меня была такая ситуация сегодня. Вот мой код. Ниже код сохраняет прикрепление, почта также отправляет информацию. Все кредиты переданы Sid

Tested 

Sub mytry()
Dim olapp As Object
Dim olmapi As Object
Dim olmail As Object
Dim olitem As Object
Dim lrow As Integer
Dim olattach As Object
Dim str As String

Const num As Integer = 6
Const path As String = "C:\HP\"
Const emailpath As String = "C:\Dell\"
Const olFolderInbox As Integer = 6

Set olp = CreateObject("outlook.application")
Set olmapi = olp.getnamespace("MAPI")
Set olmail = olmapi.getdefaultfolder(num)

If olmail.items.restrict("[UNREAD]=True").Count = 0 Then

    MsgBox ("No Unread mails")

    Else

        For Each olitem In olmail.items.restrict("[UNREAD]=True")
            lrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1

            Range("A" & lrow).Value = olitem.Subject
            Range("B" & lrow).Value = olitem.senderemailaddress
            Range("C" & lrow).Value = olitem.to
            Range("D" & lrow).Value = olitem.cc
            Range("E" & lrow).Value = olitem.body

            If olitem.attachments.Count <> 0 Then

                For Each olattach In olitem.attachments

                    olattach.SaveAsFile path & Format(Date, "MM-dd-yyyy") & olattach.Filename

                Next olattach

            End If
    str = olitem.Subject
    str = Replace(str, "/", "-")
    str = Replace(str, "|", "_")
    Debug.Print str
            olitem.SaveAs (emailpath & str & ".msg")
            olitem.unread = False
            DoEvents
            olitem.Save
        Next olitem

End If

ActiveSheet.Rows.WrapText = False

End Sub