none
Gravar Anexos XML RRS feed

  • Pergunta

  • Bom dia,

    Fiz um código para gravar anexos XML de e-mails recebidos no outlook.

    Pretendo depois transforma-lo em um serviço.

    Eu gravo os anexos em um diretório (C:\entrada) e movo o e-mail para uma pasta no outlook chamada NFENTRADA.

    Só que ele sai fora do loop de Item quando eu movo o e-mail  para a pasta, fazendo a operaçao apenas com o primeiro encontrado.

    O que está faltando ?

    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
            ' adiciona por nome os emails recebidos
            For Each Item In Inbox.Items
                i = 0
                For Each Atmt In Item.Attachments
                    j = Atmt.FileName.IndexOf(".")
                    If j > 0 Then
                        j = j + 1
                        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
                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

    domingo, 15 de setembro de 2013 13:47