Bom dia a todos, tenho o seguinte código abaixo onde o mesmo está funcionando normalmente em meu Outlook, ele remove mensagens da caixa de entrada para uma pasta dentro de um pst local, porem caso em minha caixa de entrada possua um e-mail de erro de entrega de e-mail, ou aqueles avisos agendados no calendários, como aviso de reuniões ou caso do tipo, ele apresenta a seguinte mensagem de erro
erro em tempo de execução '13':
Tipos Incontatáveis
_________________________________________________________
Sub caixasaida()
' Declare Objects for Outlook Archive Email
Dim SourceFolder As Outlook.MAPIFolder, DestFolder As Outlook.MAPIFolder
Dim MailItem As Outlook.MailItem
Dim SourceMailBoxName As String, DestMailBoxName As String
Dim Source_Pst_Folder_Name As String, Dest_Pst_Folder_Name As String
Dim MailsCount As Double, NumberOfDays As Double
'numero de dias limite de para processamento
NumberOfDays = 30
'Caixa postal e Nome da pasta
SourceMailBoxName = "teste@teste.com.br" ''email em questão
Source_Pst_Folder_Name = "Caixa de entrada"
Set SourceFolder = Outlook.Session.Folders(SourceMailBoxName).Folders(Source_Pst_Folder_Name)
'Caixa postal e Nome da pasta para backup
DestMailBoxName = "Arquivo de Dados do Outlook" ''pst que ira receber os arquivos movidos
Dest_Pst_Folder_Name = "teste2"''pasta dentro do pst que ira receber os arquivos movidos
Set DestFolder = Outlook.Session.Folders(DestMailBoxName).Folders(Dest_Pst_Folder_Name)
MailsCount = SourceFolder.Items.Count
While MailsCount > 0
'Backups de emails antigos quato a quantidade de dias"Number of Days"
Set MailItem = SourceFolder.Items.Item(MailsCount)
If VBA.DateValue(VBA.Now) - VBA.DateValue(MailItem.ReceivedTime) >= NumberOfDays Then
SourceFolder.Items.Item(MailsCount).move DestFolder
End If
MailsCount = MailsCount - 1
Wend
End Sub
_________________________________________________________
erro em tempo de execução '13':
Tipos Incontatáveis
_________________________________________________________
Sub caixasaida()
' Declare Objects for Outlook Archive Email
Dim SourceFolder As Outlook.MAPIFolder, DestFolder As Outlook.MAPIFolder
Dim MailItem As Outlook.MailItem
Dim SourceMailBoxName As String, DestMailBoxName As String
Dim Source_Pst_Folder_Name As String, Dest_Pst_Folder_Name As String
Dim MailsCount As Double, NumberOfDays As Double
'numero de dias limite de para processamento
NumberOfDays = 30
'Caixa postal e Nome da pasta
SourceMailBoxName = "teste@teste.com.br" ''email em questão
Source_Pst_Folder_Name = "Caixa de entrada"
Set SourceFolder = Outlook.Session.Folders(SourceMailBoxName).Folders(Source_Pst_Folder_Name)
'Caixa postal e Nome da pasta para backup
DestMailBoxName = "Arquivo de Dados do Outlook" ''pst que ira receber os arquivos movidos
Dest_Pst_Folder_Name = "teste2"''pasta dentro do pst que ira receber os arquivos movidos
Set DestFolder = Outlook.Session.Folders(DestMailBoxName).Folders(Dest_Pst_Folder_Name)
MailsCount = SourceFolder.Items.Count
While MailsCount > 0
'Backups de emails antigos quato a quantidade de dias"Number of Days"
Set MailItem = SourceFolder.Items.Item(MailsCount)
If VBA.DateValue(VBA.Now) - VBA.DateValue(MailItem.ReceivedTime) >= NumberOfDays Then
SourceFolder.Items.Item(MailsCount).move DestFolder
End If
MailsCount = MailsCount - 1
Wend
End Sub
_________________________________________________________