- 03 Jul 2019 às 21:24
#45284
Olá Osvaldo.
O erro está na mesma linha:
Sub LerXml(ByVal strFolderPath As String)
O VBA sublinha também:
Dim xmlDoc As DOMDocument
Sub LerXml(ByVal strFolderPath As String)
'Declaração de variaveis de objeto para leitura do XML
Dim xmlDoc As DOMDocument
Dim xmlList As IXMLDOMNodeList
Dim xmlNode As IXMLDOMNode
'Declaração de variaveis diversas para o código
Dim shtXml As Worksheet
Dim strXml As String
Dim x, y, i As Long
Dim objPasta As FileDialog
'Declaração de variaveis de retorno do XML
Dim strVersao As String
Dim strEmitente As String
Dim strCNPJEmi As String
Dim strIEEmite As String
Dim strRegTrib As String
Dim strNoNFe As String
Dim strSerie As String
Dim strDEmi As String
Dim strChaveNFe As String
Dim strCodProd As String
Dim strDescric As String
Dim strNCM As String
Dim intCFOP As Integer
Dim strEAN As String
Dim strEANTrib As String
Dim dblQtdCom As Double
Dim dblQtdTri As Double
Dim dblVlrCom As Double
Dim dblVlrTri As Double
Dim strVlrFrt As String
Dim dblVlrFrt As Double
Dim strVlrSeg As String
Dim dblVlrSeg As Double
Dim strVlrDes As String
Dim dblVlrDes As Double
Dim strVlrOut As String
Dim dblVlrOut As Double
Dim dblVlrTot As Double
Dim strIcmsOr As String
Dim strIcmsCst As String
Dim strIcmsVlr As String
Dim dblIcmsVlr As Double
Dim strIcmsAlq As String
Dim dblIcmsAlq As Double
Dim strPisCST As String
Dim strvBCPis As String
Dim dblvBCPis As Double
Dim strPisAlq As String
Dim dblPisAlq As Double
Dim strPisVlr As String
Dim dblPisVlr As Double
Dim strCofinCST As String
Dim strCofinAlq As String
Dim dblCofinAlq As Double
Dim strCofinVlr As String
Dim dblCofinVlr As Double
Dim strIcmsBcSt As String
Dim dblIcmsBcSt As Double
Dim strIcmsStVr As String
Dim dblIcmsStVr As Double
Dim strIpiCST As String
Dim strIpiVr As String
Dim dblIpiVr As Double
'Atribuindo caminho do arquivo a variavel
strXml = strFolderPath
'Carregando o objeto que irá representar o documento XML
Set xmlDoc = New DOMDocument
'Carregando o arquivo
xmlDoc.Load (strXml)
'Versão da NFE
For i = 0 To xmlDoc.SelectSingleNode("/nfeProc/NFe/infNFe").Attributes.Length - 1
If LCase(xmlDoc.SelectSingleNode("/nfeProc/NFe/infNFe").Attributes(i).nodeName) = "versao" Then
strVersao = xmlDoc.SelectSingleNode("/nfeProc/NFe/infNFe").Attributes(i).NodeValue
Exit For
End If
Next
'Leitura da Tag ide
For Each xmlNode In xmlDoc.getElementsByTagName("ide")
'Verificar se o XML é Nfe pela existencia da Tag numero da nNF (número da nota)
If xmlNode.SelectNodes("nNF").Length = 0 Then
MsgBox "Não é um xml"
Exit Sub
End If
'Numero da nota fiscal
strNoNFe = xmlNode.SelectNodes("nNF")(0).Text
'Série da nota fiscal
strSerie = xmlNode.SelectNodes("serie")(0).Text
'Data de emissão
Select Case strVersao
Case "4.00"
strDEmi = VBA.Format(VBA.Left(xmlNode.SelectNodes("dhEmi")(0).Text, 10), "dd/mm/yyyy")
Case "3.10"
strDEmi = VBA.Format(VBA.Left(xmlNode.SelectNodes("dhEmi")(0).Text, 10), "dd/mm/yyyy")
Case Else
strDEmi = VBA.Right(xmlNode.SelectNodes("dEmi")(0).Text, 2) & "/" & _
VBA.Mid(xmlNode.SelectNodes("dEmi")(0).Text, 6, 2) & "/" & _
VBA.Left(xmlNode.SelectNodes("dEmi")(0).Text, 4)
End Select
Next
'Leitura da Tab emit (Emitente)
For Each xmlNode In xmlDoc.getElementsByTagName("emit")
'Razão social do emitente
strEmitente = xmlNode.SelectNodes("xNome")(0).Text
'CNPJ do emitente
strCNPJEmi = "'" & xmlNode.SelectNodes("CNPJ")(0).Text
'Inscrição Estadual do emitente
strIEEmite = "'" & xmlNode.SelectNodes("IE")(0).Text
'Regime tributario
x = xmlNode.SelectNodes("CRT")(0).Text
Select Case x
Case 1
strRegTrib = "Simples Nacional"
Case 2
strRegTrib = "Simples Nacional, excesso sublimite de receita bruta"
Case 3
strRegTrib = "Regime Normal"
End Select
Next
'Chave da NFe
For Each xmlNode In xmlDoc.getElementsByTagName("infProt")
If xmlNode.SelectNodes("chNFe").Length > 0 Then
strChaveNFe = "'" & xmlNode.SelectNodes("chNFe")(0).Text
End If
Next
Set shtXml = ThisWorkbook.Sheets("Plan1")
i = shtXml.Range("A1048576").End(xlUp).Row + 1
'Aqui vamos iniciar a ler os produtos da nota fiscal e carregar as linhas no excel conforme esses produtos
Set xmlList = xmlDoc.getElementsByTagName("det")
For Each xmlNode In xmlList
strVlrFrt = ""
dblVlrFrt = 0
strVlrSeg = ""
dblVlrSeg = 0
strVlrDes = ""
dblVlrDes = 0
strVlrOut = ""
dblVlrOut = 0
strIcmsVlr = ""
dblIcmsVlr = 0
strIcmsAlq = ""
dblIcmsAlq = 0
strPisAlq = ""
dblPisAlq = 0
strvBCPis = ""
dblvBCPis = 0
strPisVlr = ""
dblPisVlr = 0
strCofinAlq = ""
dblCofinAlq = 0
strCofinVlr = ""
dblCofinVlr = 0
strIcmsBcSt = ""
dblIcmsBcSt = 0
strIcmsStVr = ""
dblIcmsStVr = 0
strIpiVr = ""
dblIpiVr = 0
strCodProd = GetNodeValue(xmlNode, "prod/cProd")
strDescric = GetNodeValue(xmlNode, "prod/xProd")
strNCM = GetNodeValue(xmlNode, "prod/NCM")
intCFOP = GetNodeValue(xmlNode, "prod/CFOP")
strEAN = "'" & GetNodeValue(xmlNode, "prod/cEAN")
If strEAN = "'" Then strEAN = ""
strEANTrib = "'" & GetNodeValue(xmlNode, "prod/cEANTrib")
If strEANTrib = "'" Then strEANTrib = ""
dblQtdCom = VBA.Replace(GetNodeValue(xmlNode, "prod/qCom"), ".", ",")
dblQtdTri = VBA.Replace(GetNodeValue(xmlNode, "prod/qTrib"), ".", ",")
dblVlrCom = VBA.Replace(GetNodeValue(xmlNode, "prod/vUnCom"), ".", ",")
dblVlrTri = VBA.Replace(GetNodeValue(xmlNode, "prod/vUnTrib"), ".", ",")
strVlrFrt = VBA.Replace(GetNodeValue(xmlNode, "prod/vFrete"), ".", ",")
If strVlrFrt <> "" Then
dblVlrFrt = strVlrFrt
End If
strVlrSeg = VBA.Replace(GetNodeValue(xmlNode, "prod/vSeg"), ".", ",")
If strVlrSeg <> "" Then
dblVlrSeg = strVlrSeg
End If
strVlrDes = VBA.Replace(GetNodeValue(xmlNode, "prod/vDesc"), ".", ",")
If strVlrDes <> "" Then
dblVlrDes = strVlrDes
End If
strVlrOut = VBA.Replace(GetNodeValue(xmlNode, "prod/vOutro"), ".", ",")
If strVlrOut <> "" Then
dblVlrOut = strVlrOut
End If
dblVlrTot = VBA.Replace(GetNodeValue(xmlNode, "prod/vProd"), ".", ",")
strIcmsOr = GetICMS(xmlNode, 1)
strIcmsCst = "'" & GetICMS(xmlNode, 2)
If strIcmsCst = "'" Then strIcmsCst = ""
strIcmsVlr = VBA.Replace(GetICMS(xmlNode, 3), ".", ",")
If strIcmsVlr <> "" Then
dblIcmsVlr = strIcmsVlr
End If
strIcmsAlq = VBA.Replace(GetICMS(xmlNode, 4), ".", ",")
If strIcmsAlq <> "" Then
dblIcmsAlq = strIcmsAlq
dblIcmsAlq = dblIcmsAlq / 100
End If
'Pis
strPisCST = "'" & GetPIS(xmlNode, 1)
If strPisCST = "'" Then strPisCST = ""
strPisVlr = VBA.Replace(GetPIS(xmlNode, 2), ".", ",")
If strvBCPis <> "" Then
dblvBCPis = strvBCPis
End If
strPisAlq = VBA.Replace(GetPIS(xmlNode, 3), ".", ",")
If strPisAlq <> "" Then
dblPisAlq = strPisAlq
dblPisAlq = dblPisAlq / 100
End If
strPisVlr = VBA.Replace(GetPIS(xmlNode, 4), ".", ",")
If strPisVlr <> "" Then
dblPisVlr = strPisVlr
End If
strCofinCST = "'" & GetCOFINS(xmlNode, 1)
If strCofinCST = "'" Then strCofinCST = ""
strCofinAlq = VBA.Replace(GetCOFINS(xmlNode, 2), ".", ",")
If strCofinAlq <> "" Then
dblCofinAlq = strCofinAlq
dblCofinAlq = dblCofinAlq / 100
End If
strCofinVlr = VBA.Replace(GetCOFINS(xmlNode, 3), ".", ",")
If strCofinVlr <> "" Then
dblCofinVlr = strCofinVlr
End If
'''''''''''
strIcmsBcSt = VBA.Replace(GetICMS(xmlNode, 5), ".", ",")
If strIcmsBcSt <> "" Then
dblIcmsBcSt = strIcmsBcSt
End If
strIcmsStVr = VBA.Replace(GetICMS(xmlNode, 6), ".", ",")
If strIcmsStVr <> "" Then
dblIcmsStVr = strIcmsStVr
End If
strIpiCST = "'" & GetIPI(xmlNode, 1)
If strIpiCST = "'" Then strIpiCST = ""
strIpiVr = VBA.Replace(GetIPI(xmlNode, 2), ".", ",")
If strIpiVr <> "" Then
dblIpiVr = strIpiVr
End If
'Carregando informações na planilha
shtXml.Cells(i, 1).Value = strEmitente
shtXml.Cells(i, 2).Value = strCNPJEmi
shtXml.Cells(i, 3).Value = strIEEmite
shtXml.Cells(i, 4).Value = strRegTrib
shtXml.Cells(i, 5).Value = strNoNFe
shtXml.Cells(i, 6).Value = strSerie
shtXml.Cells(i, 7).Value = VBA.CDate(strDEmi)
shtXml.Cells(i, 8).Value = strChaveNFe
shtXml.Cells(i, 9).Value = strCodProd
shtXml.Cells(i, 10).Value = strDescric
shtXml.Cells(i, 11).Value = strNCM
shtXml.Cells(i, 12).Value = intCFOP
shtXml.Cells(i, 13).Value = strEAN
shtXml.Cells(i, 14).Value = strEANTrib
shtXml.Cells(i, 15).Value = dblQtdCom
shtXml.Cells(i, 16).Value = dblQtdTri
shtXml.Cells(i, 17).Value = dblVlrCom
shtXml.Cells(i, 18).Value = dblVlrTri
shtXml.Cells(i, 19).Value = dblVlrFrt
shtXml.Cells(i, 20).Value = dblVlrSeg
shtXml.Cells(i, 21).Value = dblVlrDes
shtXml.Cells(i, 22).Value = dblVlrOut
shtXml.Cells(i, 23).Value = dblVlrTot
shtXml.Cells(i, 24).Value = strIcmsOr
shtXml.Cells(i, 25).Value = strIcmsCst
shtXml.Cells(i, 26).Value = dblIcmsAlq
shtXml.Cells(i, 27).Value = dblIcmsVlr
shtXml.Cells(i, 28).Value = dblIcmsBcSt
shtXml.Cells(i, 29).Value = dblIcmsStVr
shtXml.Cells(i, 30).Value = strPisCST
shtXml.Cells(i, 31).Value = dblvBCPis
shtXml.Cells(i, 32).Value = dblPisAlq
shtXml.Cells(i, 33).Value = dblPisVlr
shtXml.Cells(i, 34).Value = strCofinCST
shtXml.Cells(i, 35).Value = dblCofinAlq
shtXml.Cells(i, 36).Value = dblCofinVlr
shtXml.Cells(i, 37).Value = strIpiCST
shtXml.Cells(i, 38).Value = dblIpiVr
i = i + 1
Next
Set shtXml = Nothing
Set xmlList = Nothing
Set xmlNode = Nothing
Set xmlDoc = Nothing
End Sub
