Ошибка выполнения Outlook-VBA '91 при сохранении вложений электронной почты - PullRequest
Новая
       131

Ошибка выполнения Outlook-VBA '91 при сохранении вложений электронной почты

0 голосов
/ 29 мая 2020

Мы используем общий почтовый ящик Outlook, и нам нужно сохранить некоторые вложения из этого письма. Мне нужен макрос:

  • Разрешить пользователю выбирать несколько электронных писем и сохранять все вложения в выбранном
  • Разрешить пользователю выбирать, в какую папку сохранять вложения (это каждый раз будет отличаться)
  • Добавьте ReceivedTime к имени файла, так как мы получаем несколько вложений электронной почты с тем же именем, но они всегда приходят в разные дни
  • Не хочу изменять исходное электронное письмо любым способом (не удаляйте вложение и не добавляйте примечания к электронному письму)

Вот код, который у меня есть, я никогда раньше ничего не писал в Outlook, и я комбинировал разные строки из макросов, которые я нашел. При этом макрос не работает. Я получаю сообщение об ошибке

«Ошибка выполнения 91:» объектная переменная или с не заданной блочной переменной »в обеих строках с« *** »

. Я удаляю dateFormat из макроса и SaveAs, и по-прежнему появляется ошибка времени выполнения в строке SaveAs. 

Sub saveAttachment()
    Dim objOL As Outlook.Application
    Dim objMsg As Outlook.MailItem
    Dim objAtt As Outlook.Attachment
    Dim objSel As Outlook.Selection
    Dim lngCount As Long
    Dim sFolder As String
    Dim dateFormat As String
        ***dateFormat = Format(objMsg.ReceivedTime, "yyyy-mm-dd")***
    Dim xlObj As Excel.Application
    Set xlObj = New Excel.Application
    ' Open the select folder prompt
    With xlObj.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then ' if OK is pressed
            sFolder = .SelectedItems(1)
        ElseIf .Show = 0 Then
            MsgBox "Failed to select folder to save attachements to"
        Exit Sub
        End If
    End With
    xlObj.Quit
    Set xlObj = Nothing
Set objOL = CreateObject("Outlook.Application")
Set objSelection = objOL.ActiveExplorer.Selection
For Each objMsg In objSelection
 Set objAttachments = objMsg.Attachments
    lngCount = objAttachments.Count
    If lngCount > 0 Then
    ***objAtt.SaveAsFile sFolder & "\" & objAtt.FileName & dateFormat***
Else
MsgBox "No attachements selected"
End If
Next
End Sub

Мы используем Office365, на случай, если это имеет значение. Любая помощь будет очень востребована .

1 Ответ

0 голосов
/ 30 мая 2020

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

Set objOL = CreateObject("Outlook.Application")
Set objSelection = objOL.ActiveExplorer.Selection
For Each objMsg In objSelection
    Set objAttachments = objMsg.Attachments
    lngCount = objAttachments.Count
    If lngCount > 0 Then
      dateFormat = Format(objMsg.ReceivedTime, "yyyy-mm-dd")
      objAtt.SaveAsFile sFolder & "\" & objAtt.FileName & dateFormat
    Else
      MsgBox "No attachements selected"
    End If
Next

Вы можете найти статью Начало работы с VBA в Office полезной.

...