Добрый день! Подскажите, использую код VBA для сохранения файлов с отчетами, соответствующих определенной маске. Все работает, но есть одна проблема, через outlook создают различные встречи и собрания, и когда такое сообщение приходит в почту, код выдает ошибку, Run-time error '13': Type mismatch. Я так понимаю, что ошибка в связи с тем, что сообщение от календаря не является письмом, а код пытается его обработать. Как-то можно добавить условие, чтобы он такие сообщения игнорировал?
Код
Private Sub Application_NewMail()
Dim myFolder As Outlook.MAPIFolder
Dim mi As MailItem
DestFolder = "D:\путь к папке\"
Set myFolder = Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
For Each mi In myFolder.Items.Restrict("[Unread]=TRUE")
If mi.Class = olMail Then
If mi.Attachments.Count > 0 Then
For j = 1 To mi.Attachments.Count
If InStr(1, mi.Attachments.Item(j).FileName, "Имя файла", vbTextCompare) > 0 And _
InStr(1, mi.Attachments.Item(j).FileName, Date, vbTextCompare) > 0 Then
If Len(Dir(DestFolder & "файлы " & Date, vbDirectory)) = 0 Then
MkDir DestFolder & "файлы " & Date
End If
Debug.Print (DestFolder & mi.Attachments.Item(j).DisplayName)
mi.Attachments.Item(j).SaveAsFile DestFolder & "файлы " & Date & "\" & mi.Attachments.Item(j).FileName
mi.UnRead = False
End If
Next j
End If
End If
Next mi
End Sub
doober, Спасибо! код работает корректно, но к сожалению мой подход с ошибкой вопроса не решил, ошибка вылетает на обращении к следующему элементу next mi, и до отсеивания по типу элемента не доходит.
В общем "кустарное", обходное решение, убираем объявление типа mi, и проверяем тип объекта в цикле. Таким образом проскакиваем события календаря и задачи. Была еще мысль через For Each mi In myFolder.Items.Restrict("[Unread]='TRUE' And [TypeName]='MailItem'"), но такое условие не пропускает.
Код
Private Sub Application_NewMail()
Dim myFolder As Outlook.MAPIFolder
Dim mi
DestFolder = "D:\путь к папке\"
Set myFolder = Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
For Each mi In myFolder.Items.Restrict("[Unread]=TRUE")
If mi.Class = olMail Then
If mi.Attachments.Count > 0 Then
For j = 1 To mi.Attachments.Count
If InStr(1, mi.Attachments.Item(j).FileName, "Имя файла", vbTextCompare) > 0 And _
InStr(1, mi.Attachments.Item(j).FileName, Date, vbTextCompare) > 0 Then
If Len(Dir(DestFolder & "файлы " & Date, vbDirectory)) = 0 Then
MkDir DestFolder & "файлы " & Date
End If
Debug.Print (DestFolder & mi.Attachments.Item(j).DisplayName)
mi.Attachments.Item(j).SaveAsFile DestFolder & "файлы " & Date & "\" & mi.Attachments.Item(j).FileName
mi.UnRead = False
End If
Next j
End If
End If
Next mi
End Sub