MS OutLook - Сохранение вложения из сообщения по пути
Вытаскивает вложение из сообщения с заданной темой и сохраняет его как файл с заданным именем
Пример Использования:
MySubject = "Обновление данных"
MyFilePath = "C:\Temp\new.mdb"
Call GetMessage(MySubject, MyFilePath)
Function GetMessage(ByVal FindSubject As String, ByVal MyFilePath As String)
Dim MySubject As String
Dim myOlApp As Object
Dim myNameSpace As Object
Dim MyFolder As Object
Dim myItem As Object
Dim myAttachments As Object
Dim i As Long, x As Long
Dim OlNotRunning As Boolean
On Error Resume Next
Set myOlApp = GetObject(, "Outlook.Application")
If Err.Number <= 0 Then
OlNotRunning = True
Err.Clear
Set myOlApp = CreateObject("Outlook.Application")
End If
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set MyFolder = myNameSpace.GetDefaultFolder(6)
x = MyFolder.Items.count
With MyFolder
For i = 1 To x
Set myItem = .Items(i)
MySubject = myItem.Subject
If MySubject = FindSubject Then
Set myAttachments = myItem.Attachments
myAttachments.Item(1).SaveAsFile MyFilePath
myItem.Delete
Exit For
End If
Next i
End With
If OlNotRunning = True Then
myOlApp.Quit
End If
End Function
|