Я хочу загрузить файл Excel из писем, полученных ежедневно за последний год.
Каждое письмо имеет один файл Excel, и имена файлов Excel совпадают, за исключением даты, которая показанакак «ГГГГММДД».
У меня есть почта с файлами Excel в папке в Outlook.Я хотел бы, чтобы каждый файл Excel шел к соответствующему месяцу в папке за пределами Outlook.
У меня есть код, который загружает файл Excel, но есть несколько барьеров:
Макрос работает только один раз, мне нужно, чтобы он работал в цикле.
Макрос ищет непрочитанные электронные письма в моем почтовом ящике, а затем загружает и связанные файлы Excel.Я хотел бы, чтобы макрос был либо A. Поиск электронной почты для конкретного текста в теме, либо B. Загрузите файлы Excel любых электронных писем, которые уже прочитаны.Когда я изменяю код с [UNREAD] = True на [READ] = True, он ломается.
Может быть, самое важное, я хотел бы сохранить файл Excel в папке определенного месяцав зависимости от того, какая дата в файле Excel.(это будет папка вне Outlook).
Макрос сохраняет отдельный файл .pdf при каждом сохранении файла Excel.Файл .pdf ничего не показывает.Если не сломать ничего, но это не идеально.
Оригинальный код, созданный Siddharth Rout: ( Скачать вложение из Outlook и открыть в Excel )
Вот код, который я использую:
Sub Stack_Overflow_Test()
Dim olapp As Object
Dim olmapi As Object
Dim olmail As Object
Dim olitem As Object
Dim lrow As Integer
Dim olattach As Object
Dim str As String
Const num As Integer = 6
Const path As String = "S:\Actg\sec\TESTING\Attachments from
Outlook\October\"
Const emailpath As String = "S:\Actg\sec\TESTING\Attachments from
Outlook\October\"
Const olFolderInbox As Integer = 6
Set olp = CreateObject("outlook.application")
Set olmapi = olp.getnamespace("MAPI")
Set olmail = olmapi.getdefaultfolder(num)
If olmail.items.restrict("[UNREAD]=True").Count = 0 Then
MsgBox ("No Unread mails")
Else
For Each olitem In olmail.items.restrict("[UNREAD]=True")
lrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1
Range("A" & lrow).Value = olitem.Subject
Range("B" & lrow).Value = olitem.senderemailaddress
Range("C" & lrow).Value = olitem.To
Range("D" & lrow).Value = olitem.cc
Range("E" & lrow).Value = olitem.body
If olitem.attachments.Count <> 0 Then
For Each olattach In olitem.attachments
olattach.SaveAsFile path & olattach.Filename
Next olattach
End If
str = olitem.Subject
str = Replace(str, "/", "-")
str = Replace(str, "|", "_")
Debug.Print str
olitem.unread = False
DoEvents
Next olitem
End If
ActiveSheet.Rows.WrapText = False
End Sub