[Resolvido]Mover mensagens do Outlook

Bom dia Amigos,

Estou utilizando o modulo abaixo para mover mensagens de
uma pasta do Outlook para outra.

Código:

Public Sub Move_Pasta()

    Dim objApp As Outlook.Application
    Dim olNamespace As Outlook.NameSpace
    Dim objDestino As Outlook.MAPIFolder
    Dim objItem As Outlook.MailItem
   
    Set objApp = New Outlook.Application
    Set olNamespace = objApp.GetNamespace("MAPI")

  For Each objItem In olNamespace.Folders("Pastas Particulares").Folders("Caixa de Entrada").Folders("PastaTeste").Items 'Pasta de Origem
   
        If objItem.Class = olMail Then
        Set objDestino = olNamespace.Folders("Pastas Particulares").Folders("Caixa de Entrada").Folders("PastaDestino") ' Pasta Destino
          objItem.Move objDestino
       
        End If
       
       
        Next
       
    Set objItem = Nothing
    Set olNamespace = Nothing
    Set objApp = Nothing
   
End Sub


Se tiver uma ou duas mensagens ele funciona, mas se tiver
mais de 5 mensagens, ele não move todas.

Alguem pode me ajudar?

Sds,

Boas Pessoal

Consegui este modulo na Net e funcionou corretamente:

Para testar é so criar uma PastaOrigem e dentro da mesma criar a PastaDestino.

Código:


Public Sub MoveItems()

        Dim myOlApp As New Outlook.Application

        Dim myNameSpace As Outlook.NameSpace

        Dim myInbox As Outlook.MAPIFolder

        Dim myDestFolder As Outlook.MAPIFolder

        Dim myItems As Outlook.Items

        Dim myItem As Object

        Set myNameSpace = myOlApp.GetNamespace("MAPI")

        Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox).Folders("PastaOrigem")
                 
        Set myItems = myInbox.Items

        Set myDestFolder = myInbox.Folders("PastaDestino")

        Set myItem = myItems.Find("[SenderName] = 'ENDEREÇODEEMAIL@XXXX.COM.BR'") ' Criterio pelo Remetente

        While TypeName(myItem) <> "Nothing"

                myItem.Move myDestFolder

                Set myItem = myItems.FindNext

        Wend
Set myItem = Nothing
Set myDestFolder = Nothing
Set myItems = Nothing
Set myInbox = Nothing
Set myNameSpace = Nothing


End Sub 


Amigão, desculpe-me a curiosidade mas você esta usando essa rotina com qual finalidade... Pergunto-lhe porque as vezes nos é apresentado algo que deixamos passar desapercebido, mas que derrepente aquilo era o pulo do gato! Ou seja algo que não tinhamos visualizado mas que seria muito util...

Boa Tarde Pablo,

Este modulo foi feito para criar uma regra no outlook através do Access.

Bom, vc ia me perguntar, por que não cria esta regra diretamente no outlook?

Vou explicar o que tive que fazer.

Recebo diariamente de uma empresa varios emails onde me informam detalhadamente a confirmação de depósito das Notas Fiscais daquele dia.

Abaixo o que recebo no corpo do email:

São centenas de NFs neste formato

Dt.Pagto : 17/02/2011
Forma Pagto : CREDITO EM CONTA
Banco/Agência : xxx/xxx Conta Corrente: xxxx/x
Obrigação : 5188157/1
Nota Fiscal : 365496/UN.
Valor NF : 4.005,42
Viagem : 2989347
Valor Pago : 4.005,42

Dt.Pagto : 17/02/2011
Forma Pagto : CREDITO EM CONTA
Banco/Agência : xxx/xxx Conta Corrente: xxxx/x
Obrigação : 5186658/1
Nota Fiscal : 342609/UN.
Valor NF : 3.965,30
Viagem : 2992941
Valor Pago : 3.965,30

A minha Aplicação em Access faz o seguinte:

1 - Cria o objeto Outlook
2 - Importa todos os emails contidos nesta pasta
3 - Converte os mesmos em um arquivo txt
4 - pega deste txt todos os dados após o sinal de ":"
e envia para uma tabela
5 - Dai faço um Update na minha tabela de nfs que estão em aberto, de todos os documentos que foram pagos no dia.

Rsss, é meio louco mas funciona que é uma beleza.

6 - Então depois de tudo isto eu aciono este ultimo modulo para mover os emails que ja dei baixa para a pasta que denominei como PastaBaixados.

Deu quase um jornal mas é isso.

Abraço,