Рейтинг:
7
CHill60
Вы можете использовать Папки.Метод add [^] метод создания папок либо на основе Now или на Outlook.Сообщения.CreationDate (последнее может быть полезно, если вы хотите ретроспективно переместить материал)
Если я неправильно понял, и это папка на вашем диске C:, которую вы хотите создать, то вы можете использовать Выступление команды mkdir [^]
Edit: другие функции, которые вы можете найти полезными
Метод FolderExists [^]
Объект папок (Outlook) [^]
Редактировать - некоторые фактические код
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim dateFormat As String 'Comment 1
'dateFormat = Format(Now, "yyyy-mm-dd H-mm")
dateFormat = Format(itm.CreationTime, "yyyy-mm-dd") 'Comment 2
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim getsender As String
saveFolder = "C:\Users\UserName\Desktop\Attachments\" & dateFormat & "\" 'Comment 3
CreateFolderIfNotExists saveFolder 'Comment 4
For Each objAtt In itm.Attachments
If InStr(objAtt.FileName, ".pdf") > 0 Then
objAtt.SaveAsFile saveFolder & objAtt.DisplayName
End If
'Set objAtt = Nothing 'Comment 5
Next
End Sub
Public Sub CreateFolderIfNotExists(folderName As String)
'Parameter folderName must be a fully qualifed path including drive
'All errors are assumed to be handled by the calling code
Dim fs As Object 'Using late binding to avoid having to include a reference to Microsoft Scripting Runtime
Set fs = CreateObject("Scripting.FileSystemObject")
If Not fs.folderexists(folderName) Then
fs.createfolder (folderName) 'Comment 6
End If
End SubПункты для Примечания - смотрите пункты комментариев в коде:
Комментарий 1:
Я уже недвусмысленно дал
dateFormat тип. Я считаю, что это лучшая практика
Комментарий 2:
Я использовал дату создания письма - это позволит вам ретроспективно сохранять вложения для старых писем в правильных папках. Обратите внимание на разницу в формате, который я использовал по сравнению с вашим.
Комментарий 3:
Я добавил соответствующую дату в список.
saveFolder имя
Комментарий 4:
Я поместил код для проверки папки и создания ее в отдельную подпрограмму
Комментарий 5:
Там нет необходимости устанавливать
objAtt ни к чему после сохранения PDF-файла. Он будет переназначен циклом сразу же после этого. Вы выходите из суб после завершения цикла, так что он выйдет из области видимости и в конечном итоге будет очищен из памяти в любом случае.
Комментарий 6:
Я предложил использовать
MkDir в моем первоначальном ответе, но у меня уже есть
FileSystemObject так что я использовал
CreateFolder вместо этого здесь.
Еще Одна Правка!
Вот фрагмент кода, который получит все элементы в вашем почтовом ящике и сбросит данные отправителя в ближайшее окно
Dim objMails As Outlook.Items
Set objMails = Outlook.Application.Session.GetDefaultFolder(olFolderInbox).Items
Dim objMail As Outlook.MailItem
For Each objMail In objMails
Debug.Print objMail.Sender, objMail.SenderEmailAddress
Next
cristian frias
@CHill60 Привет, извините, я просто новичок в скриптах VBA. Не могли бы вы предоставить пример кода? То, что я пытаюсь сделать, - это если конкретный пользователь отправит электронное письмо, то вложение будет автоматически сохранено на основе папки, которая имеет имя папки определенной даты. И если папка уже существует, то вложение будет сохранено в существующей папке.
cristian frias
Кроме того, я хочу создать папку на своем диске.
cristian frias
@CHill60 большое вам спасибо за быстрый ответ. Ваш код работает хорошо. Большое спасибо, что спасли меня. =) Бог благословит всегда.
cristian frias
Привет @CHill60 я только что протестировал скрипт на нескольких ПК и учетных записях электронной почты, просто случайно столкнулся со сценарием, где есть еще одно правило от учетной записи, которое заключается в том, чтобы автоматически переместить сообщение электронной почты в отдельную папку, так как сообщение перемещается автоматическое сохранение не работает. У тебя есть какие-нибудь идеи? Огромное спасибо.
cristian frias
Привет @CHill60 надеюсь, что у вас сегодня все отлично. Я только что протестировал скрипт из нескольких учетных записей ПК и outlook и случайно столкнулся со сценарием, в котором есть еще одно правило из учетной записи, которое автоматически перемещает сообщение в другую папку, что делает автоматическое сохранение вложений не работающим. У вас есть какие-нибудь соображения по этому делу? Огромное спасибо.
CHill60
Привет, Кристиан. Я думаю, вы могли бы запустить сценарий для обеих папок? Хотя если у вас есть правила о папках, основанных на датах, возможно, отключите правило, которое в данный момент выполняет перемещение? Это действительно сильно зависит от того, каким вы хотите видеть конечный результат
cristian frias
Привет CHill60, мне удалось решить недавнюю проблему. Большое вам спасибо за ваше предложение. Я также заметил, что иногда скрипт Outlook не работает и имеет некоторые ошибки, но когда я запускаю его вручную, все в порядке. Есть ли сценарий Try catch в VBA, чтобы поймать ошибку? Огромное спасибо.
CHill60
Привет Кристиан - эквивалент Try/Catch в VBA-это "On Error Goto" (ужасно, но это все, что у нас есть). Есть достаточно хорошая запись на эту статью Обработка ошибок VBA - Полное руководство - Excel Macro Mastery[^] - следите за раздражающим всплывающим окном, пытающимся заставить вас загрузить исходный код / электронную книгу или подписаться на рассылку новостей- просто игнорируйте это.
cristian frias
Привет @CHill60 извините, что беспокою вас, у меня есть попытка добавить try/catch, но коды не работают. Можете ли вы дать мне пример try/catch, основанный на приведенном выше коде. Так что я могу проверить, правильно ли я поступаю. Спасибо.
CHill60
Помогает ли это - смотрите комментарии для объяснений
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim dateFormat As String
'If any errors occur jump to the label "errhandler"
On Error GoTo errhandler
dateFormat = Format(itm.CreationTime, "yyyy-mm-dd")
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim getsender As String
saveFolder = "C:\Users\UserName\Desktop\Attachments\" & dateFormat & "\"
CreateFolderIfNotExists saveFolder
For Each objAtt In itm.Attachments
If InStr(objAtt.Filename, ".pdf") > 0 Then
objAtt.SaveAsFile saveFolder & objAtt.DisplayName
End If
Next
cleanexit:
'We are going to ignore any errors as we exit. This must be after the clean exit label
On Error Resume Next
'If you need to tidy up any objects this is where to put that code e.g.
Set objAtt = Nothing
'This next line is essential
Exit Sub
errhandler:
'Always put something in here e.g.
MsgBox "An error has occurred: " & Err.Description
'I usually go to a clean exit label to close down any connections etc
'Alternatively just allow the routine to exit here
GoTo cleanexit
End Sub
cristian frias
@CHill60 Вау, большое спасибо, что помог мне на этом пути. У меня есть еще один вопрос, Можно ли отправить сообщение об ошибке на определенный адрес электронной почты и получить уведомление по электронной почте, если сценарий успешно продолжился? Спасибо.
cristian frias
@CHill60 Вау, большое спасибо, что помог мне на этом пути. У меня есть еще один вопрос, Можно ли отправить сообщение об ошибке на определенный адрес электронной почты и получить уведомление по электронной почте, если сценарий успешно продолжился? Спасибо.