Vídeo recomendado
https://youtu.be/diWPPPhW-9E

VBA Extrair XML NFe [RESOLVIDO]

Perguntas e Repostas sobre os artigos, posts e arquivos que são postados no site
Pereirajuta
Acabou de chegar
Acabou de chegar
Mensagens: 1
Registrado em: Seg Set 27, 2021 5:02 pm

VBA Extrair XML NFe [RESOLVIDO]

Mensagem por Pereirajuta »

Queria uma ajuda com esse macro, a onde que estou errando.
Esse código serve para quebrar extrair XML e montar planilhas Excel, como foi programado em versões antigas não estava funcionando nada. Fiz alguns ajustes voltou a funcionar em partes. Voltou a buscando a pasta e listando os XML, mas quando chega no extrair ele rodo da concluído mas não grava nada.

Vou deixar aqui o código

Código: Selecionar todos


Option Explicit
'É necessário adicionar a biblioteca Microsoft XML, vX.0
Dim xmlDOM As DOMDocument60

Private Sub LocalizaOrigem()

    Dim fDlg    As FileDialog
    Dim lPasta  As String
    Sheets("Inicial").Select
    Set fDlg = Application.FileDialog(FileDialogType:=msoFileDialogFolderPicker)
 
    'Retorna a pasta selecionada
    If fDlg.Show = -1 Then
        lPasta = fDlg.SelectedItems(1)
        'MsgBox "A pasta selecionada foi: " & lPasta
        Cells(4, 3).Value = lPasta
    Else
        MsgBox "Não foi selecionada nenhuma pasta"
    End If

End Sub

Private Sub GerarLista()

Dim FSO As Object, Pasta As Object, Arquivo As Object, Arquivos As Object, Caminho As String, a
Dim Linha As Long
Set FSO = CreateObject("Scripting.FileSystemObject")

Caminho = Sheets("Inicial").Range("C4")

If Not FSO.FolderExists(Caminho) Then
    MsgBox "A pasta '" & Caminho & "' não existe.", vbCritical, "Erro"
    Exit Sub
End If

Set Pasta = FSO.GetFolder(Caminho)
Set Arquivos = Pasta.Files

Sheets("Lista de arquivos").Select
ActiveSheet.AutoFilterMode = False
Cells.Clear
Cells.Clear
Range("a1").FormulaR1C1 = "Nome dos arquivos"


Range("a2").Select

For Each Arquivo In Arquivos
    If LCase(Right(Arquivo.Name, 4)) = ".xml" Then
        Linha = Linha + 1
        ActiveCell.FormulaR1C1 = Arquivo.Name
        ActiveCell.Offset(1, 0).Select
        'Me.Cells(Linha, 1) = UCase$(Arquivo.Path)
        'Me.Cells(Linha, 2) = Format$((Arquivo.Size / 1024), "#,##0") & " KB"
    End If
Next

    Cells.EntireColumn.AutoFit
    Range("A1").Select
    Selection.Font.Bold = True
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With

    Range("A2").Select
    a = MsgBox("Lista de arquivos XML gerada!", vbInformation, "Aviso")


End Sub
Private Sub AnalisarXML()

    Dim strArquivo As String, ws As Worksheet, c As Long, LinLista As Long, LinXMLS As Long, Porigem As String, QtdItem As Long, a
    Dim CFOP As String
    QtdItem = 1
    CFOP = "x"
    
    Sheets("XMLS").Select
    ActiveSheet.AutoFilterMode = False
    Set ws = ActiveSheet
    Cells.Clear
    Cells.Clear
    
    With ws
        c = 1
        Cells(1, c) = "Nome dos arquivos"
        c = c + 1
        Cells(1, c) = "Chave"
        c = c + 1
        Cells(1, c) = "Autorização"
        c = c + 1
        Cells(1, c) = "Modelo"
        c = c + 1
        Cells(1, c) = "Qtd"
        c = c + 1
        Cells(1, c) = "Série"
        c = c + 1
        Cells(1, c) = "NF"
        c = c + 1
        Cells(1, c) = "Emissão"
        c = c + 1
        Cells(1, c) = "Nome Emitente"
        c = c + 1
        Cells(1, c) = "CNPJ Emitente"
        c = c + 1
        Cells(1, c) = "Nome Destinatário"
        c = c + 1
        Cells(1, c) = "CNPJ Destinatário"
        c = c + 1
        Cells(1, c) = "Total da NF"
        c = c + 1
        Cells(1, c) = "Item"
        c = c + 1
        Cells(1, c) = "CFOP"
        c = c + 1
        Cells(1, c) = "NCM"
        c = c + 1
        Cells(1, c) = "Codigo Item"
        c = c + 1
        Cells(1, c) = "Descr. Item"
        c = c + 1
        Cells(1, c) = "Valor Item"
        c = c + 1
        Cells(1, c) = "Valor Frete"
        c = c + 1
        Cells(1, c) = "Valor Outros"
        c = c + 1
        Cells(1, c) = "CST ICMS"
        c = c + 1
        Cells(1, c) = "BC ICMS"
        c = c + 1
        Cells(1, c) = "Valor ICMS"
        c = c + 1
        Cells(1, c) = "CST IPI"
        c = c + 1
        Cells(1, c) = "BC IPI"
        c = c + 1
        Cells(1, c) = "Valor IPI"
        c = c + 1
        Cells(1, c) = "CST PIS"
        c = c + 1
        Cells(1, c) = "BC PIS"
        c = c + 1
        Cells(1, c) = "Aliq PIS"
        c = c + 1
        Cells(1, c) = "Valor PIS"
        c = c + 1
        Cells(1, c) = "CST COFINS"
        c = c + 1
        Cells(1, c) = "BC COFINS"
        c = c + 1
        Cells(1, c) = "Aliq COFINS"
        c = c + 1
        Cells(1, c) = "Valor COFINS"
        c = c + 1
    End With
    
    LinLista = 2
    LinXMLS = 2
    Porigem = Sheets("Inicial").Range("C4") & "\"
    strArquivo = Porigem & Sheets("Lista de arquivos").Range("A" & LinLista)
    
    Do While Sheets("Lista de arquivos").Range("A" & LinLista) <> "" 'Looping na lista
        Sheets("Temp").Rows("2:2").Clear
        'O objeto DOMDocument deve ser usado para manipular dados XML:
       Set xmlDOM = CreateObject("MSXML2.DOMDocument.6.0")
        xmlDOM.async = False
        'Carrega o arquivo especificado par ao objeto DOMDocument:
        xmlDOM.Load strArquivo
    
        Do While CFOP <> "" 'Looping no XML
            'Importa informações de arquivo XML:
            c = 1
            Sheets("Temp").Cells(2, c).NumberFormat = "@"
            ObterNó "/nfeProc/protNFe/infProt/chNFe", Sheets("Temp").Cells(2, c) 'Chave
            c = c + 1
            ObterNó "/nfeProc/protNFe/infProt/xMotivo", Sheets("Temp").Cells(2, c) 'Autorização
            c = c + 1
            ObterNó "/nfeProc/NFe/infNFe/ide/mod", Sheets("Temp").Cells(2, c) 'Modelo
            c = c + 1
            Sheets("Temp").Cells(2, c).NumberFormat = "#.###0,000_);[Red](#.###0,000)"
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/prod/qCom", Sheets("Temp").Cells(2, c) 'quantidade
            c = c + 1
            ObterNó "/nfeProc/NFe/infNFe/ide/serie", Sheets("Temp").Cells(2, c) 'Série
            c = c + 1
            ObterNó "/nfeProc/NFe/infNFe/ide/nNF", Sheets("Temp").Cells(2, c) 'NF
            c = c + 1
            ObterNó "/nfeProc/NFe/infNFe/ide/dEmi", Sheets("Temp").Cells(2, c) 'Data de emissão (na versao 3.1 mudou para dhEmi)
            If Sheets("Temp").Cells(2, c) = "" Then
                ObterNó "/nfeProc/NFe/infNFe/ide/dhEmi", Sheets("Temp").Cells(2, c)
                If Sheets("Temp").Cells(2, c) <> "" Then Sheets("Temp").Cells(2, c) = Mid(Sheets("Temp").Cells(2, c), 6, 2) & "/" & Mid(Sheets("Temp").Cells(2, c), 9, 2) & "/" & Mid(Sheets("Temp").Cells(2, c), 1, 4)
            End If
            c = c + 1
            ObterNó "/nfeProc/NFe/infNFe/emit/xNome", Sheets("Temp").Cells(2, c) 'Nome Emitente
            c = c + 1
            Sheets("Temp").Cells(2, c).NumberFormat = "@"
            ObterNó "/nfeProc/NFe/infNFe/emit/CNPJ", Sheets("Temp").Cells(2, c) 'CNPJ Emitente
            c = c + 1
            ObterNó "/nfeProc/NFe/infNFe/dest/xNome", Sheets("Temp").Cells(2, c) 'Nome Destinatário
            c = c + 1
            Sheets("Temp").Cells(2, c).NumberFormat = "@"
            ObterNó "/nfeProc/NFe/infNFe/dest/CNPJ", Sheets("Temp").Cells(2, c) 'CNPJ Destinatário
            c = c + 1
            Sheets("Temp").Cells(2, c).NumberFormat = "#,##0.00_);[Red](#,##0.00)"
            If QtdItem = 1 Then
                ObterNó "/nfeProc/NFe/infNFe/total/ICMSTot/vNF", Sheets("Temp").Cells(2, c) 'Valor total da NFe
                Else
                Cells(2, c) = 0
            End If
            c = c + 1
            Sheets("Temp").Cells(2, c).Value = QtdItem 'Número do item da NF
            c = c + 1
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/prod/CFOP", Sheets("Temp").Cells(2, c) 'CFOP
            CFOP = Sheets("Temp").Cells(2, c)
            c = c + 1
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/prod/NCM", Sheets("Temp").Cells(2, c) 'NCM
            c = c + 1
            Sheets("Temp").Cells(2, c).NumberFormat = "@"
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/prod/cProd", Sheets("Temp").Cells(2, c) 'Código do produto
            c = c + 1
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/prod/xProd", Sheets("Temp").Cells(2, c) 'Descrição do produto
            c = c + 1
            Sheets("Temp").Cells(2, c).NumberFormat = "#,##0.00_);[Red](#,##0.00)"
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/prod/vProd", Sheets("Temp").Cells(2, c) 'Valor do produto
            c = c + 1
            Sheets("Temp").Cells(2, c).NumberFormat = "#,##0.00_);[Red](#,##0.00)"
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/prod/vFrete", Sheets("Temp").Cells(2, c) 'Valor frete
            c = c + 1
            Sheets("Temp").Cells(2, c).NumberFormat = "#,##0.00_);[Red](#,##0.00)"
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/prod/vOutro", Sheets("Temp").Cells(2, c) 'Valor outros
            c = c + 1
            Sheets("Temp").Cells(2, c).NumberFormat = "00"
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/ICMS/ICMS00/CST", Sheets("Temp").Cells(2, c) 'CST ICMS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/ICMS/ICMS10/CST", Sheets("Temp").Cells(2, c) 'CST ICMS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/ICMS/ICMS20/CST", Sheets("Temp").Cells(2, c) 'CST ICMS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/ICMS/ICMS30/CST", Sheets("Temp").Cells(2, c) 'CST ICMS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/ICMS/ICMS40/CST", Sheets("Temp").Cells(2, c) 'CST ICMS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/ICMS/ICMS51/CST", Sheets("Temp").Cells(2, c) 'CST ICMS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/ICMS/ICMS60/CST", Sheets("Temp").Cells(2, c) 'CST ICMS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/ICMS/ICMS70/CST", Sheets("Temp").Cells(2, c) 'CST ICMS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/ICMS/ICMS90/CST", Sheets("Temp").Cells(2, c) 'CST ICMS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/ICMS/ICMSPart/CST", Sheets("Temp").Cells(2, c) 'CST ICMS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/ICMS/ICMSST/CST", Sheets("Temp").Cells(2, c) 'CST ICMS
            c = c + 1
            Sheets("Temp").Cells(2, c).NumberFormat = "#,##0.00_);[Red](#,##0.00)"
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/ICMS/ICMS00/vBC", Sheets("Temp").Cells(2, c) 'BC ICMS
            c = c + 1
            Sheets("Temp").Cells(2, c).NumberFormat = "#,##0.00_);[Red](#,##0.00)"
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/ICMS/ICMS00/vICMS", Sheets("Temp").Cells(2, c) 'Valor ICMS
            c = c + 1
            Sheets("Temp").Cells(2, c).NumberFormat = "00"
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/IPI/IPITrib/CST", Sheets("Temp").Cells(2, c) 'CST IPI
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/IPI/IPINT/CST", Sheets("Temp").Cells(2, c) 'CST IPI
            c = c + 1
            Sheets("Temp").Cells(2, c).NumberFormat = "#,##0.00_);[Red](#,##0.00)"
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/IPI/IPITrib/vBC", Sheets("Temp").Cells(2, c) 'BC IPI
            c = c + 1
            Sheets("Temp").Cells(2, c).NumberFormat = "#,##0.00_);[Red](#,##0.00)"
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/IPI/IPITrib/vIPI", Sheets("Temp").Cells(2, c) 'Valor do IPI
            c = c + 1
            Sheets("Temp").Cells(2, c).NumberFormat = "00"
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/PIS/PISAliq/CST", Sheets("Temp").Cells(2, c) 'CST PIS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/PIS/PISQtde/CST", Sheets("Temp").Cells(2, c) 'CST PIS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/PIS/PISNT/CST", Sheets("Temp").Cells(2, c) 'CST PIS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/PIS/PISOutr/CST", Sheets("Temp").Cells(2, c) 'CST PIS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/PIS/PISST/CST", Sheets("Temp").Cells(2, c) 'CST PIS
            c = c + 1
            Sheets("Temp").Cells(2, c).NumberFormat = "#,##0.00_);[Red](#,##0.00)"
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/PIS/PISAliq/vBC", Sheets("Temp").Cells(2, c) 'BC PIS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/PIS/PISQtde/vBC", Sheets("Temp").Cells(2, c) 'BC PIS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/PIS/PISNT/vBC", Sheets("Temp").Cells(2, c) 'BC PIS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/PIS/PISOutr/vBC", Sheets("Temp").Cells(2, c) 'BC PIS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/PIS/PISST/vBC", Sheets("Temp").Cells(2, c) 'BC PIS
            c = c + 1
            Sheets("Temp").Cells(2, c).NumberFormat = "#,##0.0000_);[Red](#,##0.0000)"
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/PIS/PISAliq/pPIS", Sheets("Temp").Cells(2, c) 'Aliquota do PIS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/PIS/PISQtde/pPIS", Sheets("Temp").Cells(2, c) 'Aliquota do PIS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/PIS/PISNT/pPIS", Sheets("Temp").Cells(2, c) 'Aliquota do PIS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/PIS/PISOutr/pPIS", Sheets("Temp").Cells(2, c) 'Aliquota do PIS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/PIS/PISST/pPIS", Sheets("Temp").Cells(2, c) 'Aliquota do PIS
            c = c + 1
            Sheets("Temp").Cells(2, c).NumberFormat = "#,##0.00_);[Red](#,##0.00)"
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/PIS/PISAliq/vPIS", Sheets("Temp").Cells(2, c) 'Valor do PIS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/PIS/PISQtde/vPIS", Sheets("Temp").Cells(2, c) 'Valor do PIS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/PIS/PISNT/vPIS", Sheets("Temp").Cells(2, c) 'Valor do PIS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/PIS/PISOutr/vPIS", Sheets("Temp").Cells(2, c) 'Valor do PIS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/PIS/PISST/vPIS", Sheets("Temp").Cells(2, c) 'Valor do PIS
            c = c + 1
            Sheets("Temp").Cells(2, c).NumberFormat = "00"
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/COFINS/COFINSAliq/CST", Sheets("Temp").Cells(2, c) 'CST COFINS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/COFINS/COFINSQtde/CST", Sheets("Temp").Cells(2, c) 'CST COFINS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/COFINS/COFINSNT/CST", Sheets("Temp").Cells(2, c) 'CST COFINS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/COFINS/COFINSOutr/CST", Sheets("Temp").Cells(2, c) 'CST COFINS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/COFINS/COFINSST/CST", Sheets("Temp").Cells(2, c) 'CST COFINS
            c = c + 1
            Sheets("Temp").Cells(2, c).NumberFormat = "#,##0.00_);[Red](#,##0.00)"
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/COFINS/COFINSAliq/vBC", Sheets("Temp").Cells(2, c) 'BC COFINS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/COFINS/COFINSQtde/vBC", Sheets("Temp").Cells(2, c) 'BC COFINS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/COFINS/COFINSNT/vBC", Sheets("Temp").Cells(2, c) 'BC COFINS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/COFINS/COFINSOutr/vBC", Sheets("Temp").Cells(2, c) 'BC COFINS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/COFINS/COFINSST/vBC", Sheets("Temp").Cells(2, c) 'BC COFINS
            c = c + 1
            Sheets("Temp").Cells(2, c).NumberFormat = "#,##0.0000_);[Red](#,##0.0000)"
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/COFINS/COFINSAliq/pCOFINS", Sheets("Temp").Cells(2, c) 'Aliquota do COFINS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/COFINS/COFINSQtde/pCOFINS", Sheets("Temp").Cells(2, c) 'Aliquota do COFINS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/COFINS/COFINSNT/pCOFINS", Sheets("Temp").Cells(2, c) 'Aliquota do COFINS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/COFINS/COFINSOutr/pCOFINS", Sheets("Temp").Cells(2, c) 'Aliquota do COFINS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/COFINS/COFINSST/pCOFINS", Sheets("Temp").Cells(2, c) 'Aliquota do COFINS
            c = c + 1
            Sheets("Temp").Cells(2, c).NumberFormat = "#,##0.00_);[Red](#,##0.00)"
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/COFINS/COFINSAliq/vCOFINS", Sheets("Temp").Cells(2, c) 'Valor do COFINS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/COFINS/COFINSQtde/vCOFINS", Sheets("Temp").Cells(2, c) 'Valor do COFINS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/COFINS/COFINSNT/vCOFINS", Sheets("Temp").Cells(2, c) 'Valor do COFINS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/COFINS/COFINSOutr/vCOFINS", Sheets("Temp").Cells(2, c) 'Valor do COFINS
            ObterNó "/nfeProc/NFe/infNFe/det [@nItem='" & QtdItem & "']/imposto/COFINS/COFINSST/vCOFINS", Sheets("Temp").Cells(2, c) 'Valor do COFINS
            
            If CFOP <> "" Then
                Sheets("Temp").Range("A2:Ah2").Copy
                Sheets("XMLs").Select
                Range("B" & LinXMLS).Select
                ActiveSheet.Paste
                Application.CutCopyMode = False
                Range("A" & LinXMLS) = Sheets("Lista de arquivos").Range("A" & LinLista)
                LinXMLS = LinXMLS + 1
                QtdItem = QtdItem + 1
                Sheets("Temp").Rows("2:2").Clear
            End If

        Loop

    Set xmlDOM = Nothing
    LinLista = LinLista + 1
    strArquivo = Porigem & Sheets("Lista de arquivos").Range("A" & LinLista)
    CFOP = "x"
    QtdItem = 1
    
    Loop
    
    Range("A1:AH1").Select
    Selection.Font.Bold = True
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.149998474074526
        .PatternTintAndShade = 0
    End With
    
    
    Cells.EntireColumn.AutoFit
    Range("A2").Select
        
    a = MsgBox("Concluído!", vbInformation, "Aviso")
    
End Sub

Private Function ObterNó(strNó As String, rng As Range)
    Dim objNodes As IXMLDOMNodeList
    Dim objNode As IXMLDOMNode
    Dim FileName As String
    Dim r As Long
    Dim c As Long

    Set objNodes = xmlDOM.SelectNodes(strNó)

    For Each objNode In objNodes
        If objNodes.Length > 0 Then
            rng.Offset(r) = objNode.Text
            r = r + 1
        Else
            Exit For
        End If
    Next objNode
End Function

Private Sub IterateThruElements()

    Dim xmldoc As MSXML2.DOMDocument
    Dim xmlNode As MSXML2.IXMLDOMNode
    Dim xmlNodeList As MSXML2.IXMLDOMNodeList
    Dim myNode As MSXML2.IXMLDOMNode
    Dim a

    Set xmldoc = New MSXML2.DOMDocument
    xmldoc.async = False
    xmldoc.Load (Sheets("Inicial").Range("C4") & "\" & Sheets("Lista de arquivos").Range("A2"))
    Set xmlNodeList = xmldoc.getElementsByTagName("*")
    For Each xmlNode In xmlNodeList
        For Each myNode In xmlNode.ChildNodes
          If myNode.NodeType = NODE_TEXT Then
            Debug.Print xmlNode.nodeName & "=" & xmlNode.Text
          End If
        Next myNode
    Next xmlNode
    Set xmldoc = Nothing
End Sub




Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Alex_Rodel
Acabou de chegar
Acabou de chegar
Mensagens: 3
Registrado em: Qua Ago 26, 2020 9:43 pm

Re: VBA Extrair XML NFe [RESOLVIDO]

Mensagem por Alex_Rodel »

Deu certo esse teu negócio?


Responder