none
Ajuda para fazer DEBUG em uma macro VBA RRS feed

  • Pergunta

  • Bom dia,

    Utilizo a macro abaixo para salvar anexos XML em uma determinada pasta, funciona normalmente.

    Estou precisando fazer um debug nesta macro para entender o funcionamento, porém ao executar F5 ou F8 não processa, como consigo resolver esta questão.

    Obrigado

    Romulo Avila

    ** Codigo VBA

    Public Sub SalvarXML(Email As MailItem)
        Dim DiretorioAnexos As String
        DiretorioAnexos = ""
        Dim MailID As String
        Dim Mail As Outlook.MailItem
        Dim fso

        MailID = Email.EntryID
        Set Mail = Application.Session.GetItemFromID(MailID)

        For Each Anexo In Mail.Attachments
         On Error Resume Next
            If Right(Anexo.FileName, 4) = ".xml" Or Right(Anexo.FileName, 4) = ".XML" Then
               Anexo.SaveAsFile DiretorioAnexos & Anexo.FileName
               Set objParser = CreateObject("Microsoft.XMLDOM")
                objParser.Load (DiretorioAnexos + Anexo.FileName)

                'Set ElemList = objParser.getElementsByTagName("chNFe")
                'FilePath = ElemList.Item(0).getAttribute("filepath")

                oldfilename = DiretorioAnexos + Anexo.FileName

                'Set ElemList = objParser.getElementsByTagName("nNF")
               'nNF = Format(ElemList.Item(0).Text, "000000")
       
                Set ElemList = objParser.getElementsByTagName("chNFe")
                chNFe = ElemList.Item(0).Text
                
                'Set ElemList = objParser.getElementsByTagName("xNome")
               'xNome = ElemList.Item(0).Text

                NewFileName = DiretorioAnexos + chNFe + ".xml"
               
    '            Set fso = CreateObject("Scripting.FileSystemObject")
    '               If (fso.FileExists(NewFileName)) Then
    '               fso.DeleteFile oldfilename
    '               Else
    '               fso.MoveFile oldfilename, NewFileName
    '               End If


                    Set fso = CreateObject("Scripting.FileSystemObject")
                    fso.MoveFile oldfilename, NewFileName
               
            End If
        Next

        Set Mail = Nothing
        Email.UnRead = False
        Email.Delete
    End Sub

    terça-feira, 2 de agosto de 2016 11:35

Respostas

  • André,

    Bom dia,

    Deu certo, ficou desta forma

    Set ns = GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    Set Mailbox = Inbox.Parent
    Set RptFolder = Mailbox.Folders("_Loja")

      For Each Item In Mailbox.Folders.Item("_Loja").Items

    Obrigado

    • Marcado como Resposta RomuloAvila quarta-feira, 3 de agosto de 2016 14:07
    quarta-feira, 3 de agosto de 2016 13:02
  • Boa noite Rômulo.

    Infelizmente nunca trabalhei com Outlook, por isso não estou familiarizado com seus objetos. Talvez algum outro usuário possa te ajudar melhor. Mas a ideia é basicamente o que você já citou, bastando incluir a declaração. Analisando o próprio código que vc já postou, eu chutaria algo do tipo:

    Sub Temp()
    
        Dim Email As Outlook.MailItem
        
        Set Email = Inbox.Parent.Folders("_Loja").xxxxx
        
        Call SalvarXML(Email)
    End Sub

    Mas não sei se a sintaxe para MailItem é isso (Talvez o xxxx seja algo tipo Item(1)). Talvez alguém possa corrigir.

    Abraço.


    Filipe Magno


    • Editado FilipeMagno quinta-feira, 4 de agosto de 2016 00:26
    • Marcado como Resposta RomuloAvila terça-feira, 9 de agosto de 2016 12:57
    quinta-feira, 4 de agosto de 2016 00:25

Todas as Respostas

  • Aparece alguma mensagem de erro ?

    André Santo | basevba.wordpress.com

    terça-feira, 2 de agosto de 2016 12:27
  • Bom dia,

    Não aparece mensagem de erro, se uso F8 não debuga e se teclo F5 abre a tela de Macros Gravadas mas esta macro "SALVAR XML" não aparece na lista.

    Obrigado

    terça-feira, 2 de agosto de 2016 12:31
  • Muda de SUB pra Function

    Public FunctionSalvarXML(Email As MailItem)
    
    End Function


    André Santo | basevba.wordpress.com

    terça-feira, 2 de agosto de 2016 12:42
  • André,

    Bom dia,

    Fiz a alteração e mesmo assim não executou, veja codigo abaixo:

    Public Function SalvarXML(Email As MailItem)
    Finalizei com End Function e mesmo assim não executou

    Obrigado

      

    terça-feira, 2 de agosto de 2016 13:33
  • Então.. coloque um ponto de depuração na primeira linha e configure a regra para executar essa função assim que algum email chegar, desta maneira este código será disparado e com o ponto de depuração você consegue debugar

    André Santo | basevba.wordpress.com

    terça-feira, 2 de agosto de 2016 13:43
  • André,

    Deu certo, não querendo abusar de sua ajuda..

    A macro executa a cada email que chega, como devo fazer para que ela verifique todos os emails da caixa de entrada ?

    Muito obrigado pela ajuda

    terça-feira, 2 de agosto de 2016 14:25
  • Cara, eu tenho essa macro aqui que salva todos os itens da pasta "QUERIES".

    Veja se consegue adaptar para sua necessidade

     Public Function GetAttachment()
    
    On Error GoTo GetAttachment_err
    
    ' Declaração de variáveis
    Dim ns As Namespace
    Dim Inbox As MAPIFolder
    Dim Item As Object
    Dim Atmt As Attachment
    Dim fileName As String
    Dim i As Integer
    Dim N As Integer
    Dim anexo As Variant
    
    Set ns = GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    i = 0
    
    ' Check each message for attachments
    For Each Item In Inbox.Folders.Item("queries").Items
        For Each anexo In Item.Attachments
            If anexo.fileName = "Y_VM_SUPRILOG_ZPUR_ASES_FAROL.ZIP" Or anexo.fileName = "Y_VM_SUPRILOG_ZPUR_O01_ASES.ZIP" Then
                    fileName = "\\brsaowvfs02vm\Departamento\Tecnologia\Ferramentas\Farol de RC\query\" & Format(Year(Now()), "0000") & "\" & Format(Month(Now()), "00") & "\" & Format(Day(Now()), "00") & "\" & anexo.fileName
                    anexo.SaveAsFile fileName
            End If
        Next anexo
    Next Item
    
    ' Clear memory
    GetAttachment_exit:
    Set Atmt = Nothing
    Set Item = Nothing
    Set ns = Nothing
    
    Exit Function
    
    ' Handle errors
    GetAttachment_err:
        Debug.Print Err.Description
        
        MsgBox "Erro Catastrófico!", vbInformation + vbOKOnly, "Erro"
        
        Set Atmt = Nothing
        Set Item = Nothing
        Set ns = Nothing
    
    End Function


    André Santo | basevba.wordpress.com

    • Sugerido como Resposta André Santo terça-feira, 2 de agosto de 2016 15:34
    terça-feira, 2 de agosto de 2016 15:34
  • Romulo,

    apenas para esclarecer: vc não conseguiu debugar porque sua rotina possui um argumento de entrada não opcional, ou seja, obrigatório de ser informado. Nesses casos, para fazer a depuração basta iniciar a partir de outra rotina que a chame com o argumento necessário, como por exemplo:

    Sub Temp()
    
    Call SalvarXML(Email)
    
    End Sub

    Ou ainda, mais simples, inserindo um ponto de interrupção e utilizando a janela de Verificação Imediata (Ctrl+G), digitando a chamada da função com o argumento. No caso bastaria:

    SalvarXML(Email)

    Abraço.


    Filipe Magno

    terça-feira, 2 de agosto de 2016 22:07
  • Filipe,

    Boa noite, obrigado pela dica, vou fazer os testes..

    terça-feira, 2 de agosto de 2016 22:10
  • Andre,

    Boa noite,

    No seu exemplo de salvar os itens da pasta "queries"..

    For Each Item In Inbox.Folders.Item("queries").Items
       
    For Each anexo In Item.Attachments

    Consegui fazer e deu certo, só que fiquei com uma uma duvida, tenho uma pasta chamada _Loja ( Imagem em anexo ) e não estou conseguindo apontar para ela...


    terça-feira, 2 de agosto de 2016 22:15
  • Bom dia, 

    No código acima, a pasta queries está dentro da pasta Inbox (Caixa de Entrada)

    Creio que a pasta _Loja não está na Inbox.

    Então o que teria que ser feito é trabalhar com ns.folders("_Loja") ao invés de  Inbox.folders

    Abs


    André Santo | basevba.wordpress.com

    • Sugerido como Resposta André Santo quarta-feira, 3 de agosto de 2016 11:12
    quarta-feira, 3 de agosto de 2016 11:12
  • André,

    Bom dia,

    Deu certo, ficou desta forma

    Set ns = GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    Set Mailbox = Inbox.Parent
    Set RptFolder = Mailbox.Folders("_Loja")

      For Each Item In Mailbox.Folders.Item("_Loja").Items

    Obrigado

    • Marcado como Resposta RomuloAvila quarta-feira, 3 de agosto de 2016 14:07
    quarta-feira, 3 de agosto de 2016 13:02
  • Maravilha, 

    Por favor marque como resposta.

    Precisando estamos ai 

    Abraço


    André Santo | basevba.wordpress.com

    quarta-feira, 3 de agosto de 2016 13:34
  • Filipe,

    Boa tarde,

    Fiz o teste e não executou, coloquei conforme sua indicação e dá erro de  "Tipo incompativel de argumento ByRef", meu codigo e conforme está acima, como posso resolver ?

    Sub Temp()
      Call SalvarXML(Email)
    End Sub

    Obrigado

    quarta-feira, 3 de agosto de 2016 18:24
  • Boa noite Romulo.

    Desculpe, fui um pouco direto na resposta, poderia ter detalhado melhor.

    Esse erro aconteceu porque o argumento tem tipo definido na sua rotina, no caso:

    Email As MailItem

    Então, para funcionar é preciso que informe uma variável que seja explicitamente declarada como "Outlook.MailItem".

    Compreendeu?


    Filipe Magno

    quarta-feira, 3 de agosto de 2016 22:16
  • Filipe,

    Boa noite,

    Tentei fazer e não consegui, como ficaria a rotina ?, teria como me auxiliar

    Obrigado

    Romulo

    quarta-feira, 3 de agosto de 2016 22:43
  • Boa noite Rômulo.

    Infelizmente nunca trabalhei com Outlook, por isso não estou familiarizado com seus objetos. Talvez algum outro usuário possa te ajudar melhor. Mas a ideia é basicamente o que você já citou, bastando incluir a declaração. Analisando o próprio código que vc já postou, eu chutaria algo do tipo:

    Sub Temp()
    
        Dim Email As Outlook.MailItem
        
        Set Email = Inbox.Parent.Folders("_Loja").xxxxx
        
        Call SalvarXML(Email)
    End Sub

    Mas não sei se a sintaxe para MailItem é isso (Talvez o xxxx seja algo tipo Item(1)). Talvez alguém possa corrigir.

    Abraço.


    Filipe Magno


    • Editado FilipeMagno quinta-feira, 4 de agosto de 2016 00:26
    • Marcado como Resposta RomuloAvila terça-feira, 9 de agosto de 2016 12:57
    quinta-feira, 4 de agosto de 2016 00:25