KompНиже приведен рабочий код, который будет сохранять любые вложения в сообщениях электронной почты Outlook в определенную папку на жестком диске. Чтобы заставить его работать, мне нужно выбрать все электронные письма, которые я хочу, чтобы макрос запускался. Мне нужна помощь в изменении кода для запуска в определенной папке в Outlook без выбора сообщений электронной почты вручную, а затем он сохранит все вложения excel в папке на жестком диске. Я пробовал несколько вещей, но в одном случае он преобразует все вложения в Excel файл вместо того, чтобы просто извлечь файл excel и игнорировать все остальное.
Public Sub SaveAttachments()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String
strFolderpath = "F:Test folder"
On Error Resume Next
Set objOL = CreateObject("Outlook.Application")
Set objSelection = objOL.ActiveExplorer.Selection
strFolderpath = strFolderpath & "Attachments"
For Each objMsg In objSelection
Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count
strDeletedFiles = ""
If lngCount > 0 Then
For i = lngCount To 1 Step -1
strFile = objAttachments.Item(i).FileName
strFile = strFolderpath & strFile
objAttachments.Item(i).SaveAsFile strFile
objAttachments.Item(i).Delete
If objMsg.BodyFormat <> olFormatHTML Then
strDeletedFiles = strDeletedFiles & vbCrLf & "<file://" & strFile & ">"
Else
strDeletedFiles = strDeletedFiles & "<br>" & "<a href='file://" & _
strFile & "'>" & strFile & "</a>"
End If
Next i
If objMsg.BodyFormat <> olFormatHTML Then
objMsg.Body = vbCrLf & "The file(s) were saved to " & strDeletedFiles & vbCrLf & objMsg.Body
Else
objMsg.HTMLBody = "<p>" & "The file(s) were saved to " & strDeletedFiles & "</p>" & objMsg.HTMLBody
End If
objMsg.Save
End If
Next
ExitSub:
Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub
3091
