GRAVAR ANEXO XML

VFERNANDO 15/09/2013 12:49:24
#428867

Bom dia,

Fiz um código para gravar anexos XML de e-mails recebidos no outlook e mover o e-mail da caixa de entrada para outra pasta.
Pretendo depois transforma-lo em um serviço.
Tudo ocorre corretamente, mas só para o primeiro item (e-mail) encontrado com anexo xml.
Após eu move-lo, ele sai do loop de leitura dos itens, sendo que há mais itens a serem lidos e ítens com anexo xml.
O que está errado no loop de item ?
Segue o código abaixo.
Grato
Vinicius Fernando

Imports Microsoft.Office.Interop
Public Class Form1
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim objOutlook As Outlook.Application
objOutlook = New Outlook.Application()
Dim objNS As Outlook._NameSpace = objOutlook.Session
Dim defaultConta = objNS.Accounts(1).SmtpAddress.ToString
Dim Inbox = objNS.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
Dim saidafolder = objOutlook.GetNamespace([Ô]MAPI[Ô]).Folders(defaultConta).Folders([Ô]NFENTRADA[Ô])
Dim FileName, extensao As String
Dim i, j As Integer
[ô] Leitura dos itens da caixa de entrada
For Each Item In Inbox.Items
i = 0
[ô] Leitura dos anexos do Item
For Each Atmt In Item.Attachments
j = Atmt.FileName.IndexOf([Ô].[Ô])
[ô] Verificamos se o item tem um anexo com extensão
If j > 0 Then
j = j + 1
[ô] Obtemos a extensão e verificamos se é XML e salvamos
extensao = Atmt.FileName.Substring(j, 3).ToUpper
If extensao = [Ô]XML[Ô] Then
FileName = [Ô]c:\entrada\[Ô] & Atmt.FileName
Atmt.SaveAsFile(FileName)
i = i + 1
End If
End If
Next Atmt
[ô] Se um item com xml foi encontrado, movemos o item para outra pasta
If i >= 1 Then
Item.move(saidafolder)
End If
Next Item
objOutlook = Nothing
objNS = Nothing
defaultConta = Nothing
Inbox = Nothing
saidafolder = Nothing
FileName = Nothing
extensao = Nothing
i = Nothing
j = Nothing
Me.Close()
End Sub
End Class