Здравей,
За да може да ползваш Outllok през Excel vba, трябва да добавиш библиотеката Microsoft Outlook Object Library (от Tools - References).
Този код тегли всички прикачени файлове и отваря най-новия текстови файл. Ако е необходимо, можеш да го промениш според твоите нужди, за да тегли само определен файл, който ти трябва:
Public Sub SaveAttachments()
'Set refernce to Microsoft Outlook Object Library
Application.ScreenUpdating = False
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 strExePath As String
Dim enviro As String
enviro = CStr(Environ("USERPROFILE"))
' Get the path to your folder
strFolderpath = enviro
On Error Resume Next
'Connect to MS Outlook
Set objOL = CreateObject("Outlook.Application")
Set objSelection = objOL.ActiveExplorer.Selection
' Set the Attachment folder. (Create OLAttachments folder on your Desktop)
strFolderpath = strFolderpath & "\Desktop\OLAttachments\"
'Get the attachment
For Each objMsg In objSelection
Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count
If lngCount > 0 Then
For i = lngCount To 1 Step -1
'Save the file to the Attachment folder
strFile = objAttachments.Item(i).FileName
strFile = strFolderpath & strFile
objAttachments.Item(i).SaveAsFile strFile
Next
End If
Next
Call OpenNewestTextFile
ExitSub:
Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub
Sub OpenNewestTextFile()
Dim MyPath As String
Dim MyFile As String
Dim LatestFile As String
Dim LatestDate As Date
Dim LMD As Date
Dim enviro As String
enviro = CStr(Environ("USERPROFILE"))
MyPath = enviro
MyPath = MyPath & "\Desktop\OLAttachments\"
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
MyFile = Dir(MyPath & "*.txt", vbNormal)
If Len(MyFile) = 0 Then
MsgBox "No files were found…", vbExclamation
Exit Sub
End If
Do While Len(MyFile) > 0
LMD = FileDateTime(MyPath & MyFile)
If LMD > LatestDate Then
LatestFile = MyFile
LatestDate = LMD
End If
MyFile = Dir
Loop
Workbooks.Open MyPath & LatestFile
End Sub
Aко ти е необходима повече информация по темата, може да прочетеш тази статия.
Успех!