Как автоматически сохранить вложение из Outlook?

Question

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

Мне также нужно перезаписать файл предыдущего дня, потому что эти вложения электронной почты имеют одно и то же имя каждый день.

Это то, что у меня есть, но каждый раз, когда приходит электронное письмо, оно сохраняется как новый файл, тогда как я хотел бы перезаписать существующий файл.Я ценю помощь!:)

Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String
sSaveFolder = "C:\Users\fmustapha\Documents\Outlook Attachments"
For Each oAttachment In MItem.Attachments
oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Next
End Sub

Answer 1

Я делаю это на своем сервере, каждую ночь я получаю электронное письмо с приложенным файлом Excel, которое автоматически пересылается на мой сервер, где этот код внешнего вида сохраняет вложение.Обратите внимание, что там есть пункт, чтобы убедиться, что файл получен от меня, и чтобы убедиться, что это файл Excel:

Private WithEvents olItems As Outlook.Items

Private Sub Application_Startup()
Dim objNS As Outlook.NameSpace
Set objNS = GetNamespace("MAPI")
Set olItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set objNS = Nothing
End Sub

Private Sub olItems_ItemAdd(ByVal Item As Object)
    Dim NewMail As Outlook.MailItem
    Dim Atts As Attachments
    Dim Att As Attachment
    Dim strPath As String
    Dim strName As String

    If Item.Class = olMail Then
       Set NewMail = Item
    End If
    strPath = "C:\Reporting Archive\Sales Files\"
    If NewMail.Sender = "Dan Donoghue" Then

       Set Atts = Item.Attachments

       If Atts.Count > 0 Then
          For Each Att In Atts
              If InStr(LCase(Att.FileName), ".xls") > 0 Then Att.SaveAsFile strPath & Att.FileName
          Next
       End If
    End If
End Sub

Он входит в ThisOutlookSession в VBE, как только вы положите его в закрытое состояние.и снова откройте Outlook, и он будет работать.

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

Вы сделаете это, заменив это:

If InStr(LCase(Att.FileName), ".xls") > 0 Then Att.SaveAsFile strPath & Att.FileName

на это:

If InStr(LCase(Att.FileName), ".xls") > 0 Then
    Kill strPath & Att.FileName
    Att.SaveAsFile strPath & Att.FileName
End If

в моем коде

Answer 2

Вы можете настроить правило, которое запускает это задание с любой необходимой вам частотой (вы, вероятно, не хотите, чтобы правило запускалось в секундах, а скорее, как 1 раз в день, в одночасье и т. Д.)

Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String
sSaveFolder = "C:\Users\DT168\Documents\outlook-attachments\"
For Each oAttachment In MItem.Attachments
oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Next
End Sub

https://www.extendoffice.com/documents/outlook/3747-outlook-auto-download-save-attachments-to-folder.html#a1

Answer 3

Попробуйте использовать Функция даты , которая возвращает вариант (Date), содержащий текущую системную дату.MSDN

Пример

oAttachment.SaveAsFile sSaveFolder & "New Members" & " " & Format(Date - 1, "MM-DD-YYYY")