Fábio, boa tarde! Excelente planilha essa indicada ao usuário 
Por favor, você (ou qualquer outro FERA do excel) poderia apenas acrescentar um campo nessa planilha?
no meu caso eu ia precisar de um campo chamado UNIDADE DE MEDIDA
A planilha importa vários dados do produto, porém a planilha não importa o campo unidade de medida, seria possível acrescentar esse campo ao código vba?
'Desenvolvido por Fabio Mitsueda
'http://fabiomitsueda.com.br
'Data da finalização 05/03/2018
Option Explicit
'Importante fazer referencia as dlls:
'Microsoft XML, v6.0
'Microsoft Scripting Runtime
Sub PastaXml()
'Declaração de variaves de objeto a serem utilizadas para percorrer os arquivos na pasta selecionada
Dim objFSO As Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
Dim objFile As Scripting.File
'Declarando variavel que será carregada com o nome do arquivo
Dim strCaminho As String
Dim i As Long
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then
strCaminho = .SelectedItems(1)
Set objFSO = New Scripting.FileSystemObject
Set objFolder = objFSO.GetFolder(strCaminho)
For Each objFile In objFolder.Files
If objFSO.GetExtensionName(objFile.Path) = "xml" Then
LerXml (strCaminho & "" & objFile.Name)
i = i + 1
End If
Next
' MsgBox "Processo Finalizado!!!" & vbCrLf & vbCrLf & _
'"Foi feita leitura de " & i & " arquivos XML", vbOKOnly
End If
End With
Set objFSO = Nothing
Set objFolder = Nothing
Set objFile = Nothing
End Sub
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 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.Format(xmlNode.SelectNodes("dEmi")(0).Text, "dd/mm/yyyy")
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("LerXml")
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
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
strPisCST = "'" & GetPIS(xmlNode, 1)
If strPisCST = "'" Then strPisCST = ""
strPisAlq = VBA.Replace(GetPIS(xmlNode, 2), ".", ",")
If strPisAlq <> "" Then
dblPisAlq = strPisAlq
dblPisAlq = dblPisAlq / 100
End If
strPisVlr = VBA.Replace(GetPIS(xmlNode, 3), ".", ",")
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 = 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 = dblPisAlq
shtXml.Cells(i, 32).Value = dblPisVlr
shtXml.Cells(i, 33).Value = strCofinCST
shtXml.Cells(i, 34).Value = dblCofinAlq
shtXml.Cells(i, 35).Value = dblCofinVlr
shtXml.Cells(i, 36).Value = strIpiCST
shtXml.Cells(i, 37).Value = dblIpiVr
i = i + 1
Next
Set shtXml = Nothing
Set xmlList = Nothing
Set xmlNode = Nothing
Set xmlDoc = Nothing
End Sub
Function GetNodeValue(node As IXMLDOMNode, xp As String)
Dim n As IXMLDOMNode, nv
Set n = node.SelectSingleNode(xp)
If Not n Is Nothing Then nv = n.nodeTypedValue
GetNodeValue = nv
Set n = Nothing
End Function
Function GetICMS(ByVal node As IXMLDOMNode, ByVal intCampo As Integer)
'Caso a opção intCampo seja:
'1 = origem
'2 = CST/COSN
'3 = Valor do ICMS
'4 = Aliquota ICMS
'5 = Base de calculo ICMS ST
'6 = Valor ICMS ST
Dim strCampo As String
Dim strCampoSn As String
Select Case intCampo
Case 1
strCampo = "orig"
strCampoSn = "orig"
Case 2
strCampo = "CST"
strCampoSn = "CSOSN"
Case 3
strCampo = "vICMS"
strCampoSn = "vICMS"
Case 4
strCampo = "pICMS"
strCampoSn = "pICMS"
Case 5
strCampo = "vBCST"
strCampoSn = "vBCST"
Case 6
strCampo = "vICMSST"
strCampoSn = "vICMSST"
End Select
Dim n As IXMLDOMNode, nv
Set n = node.SelectSingleNode("imposto/ICMS/ICMS00/" & strCampo)
If Not n Is Nothing Then
nv = n.nodeTypedValue
GoTo Fim
End If
Set n = node.SelectSingleNode("imposto/ICMS/ICMS10/" & strCampo)
If Not n Is Nothing Then
nv = n.nodeTypedValue
GoTo Fim
End If
Set n = node.SelectSingleNode("imposto/ICMS/ICMS20/" & strCampo)
If Not n Is Nothing Then
nv = n.nodeTypedValue
GoTo Fim
End If
Set n = node.SelectSingleNode("imposto/ICMS/ICMS30/" & strCampo)
If Not n Is Nothing Then
nv = n.nodeTypedValue
GoTo Fim
End If
Set n = node.SelectSingleNode("imposto/ICMS/ICMS40/" & strCampo)
If Not n Is Nothing Then
nv = n.nodeTypedValue
GoTo Fim
End If
Set n = node.SelectSingleNode("imposto/ICMS/ICMS41/" & strCampo)
If Not n Is Nothing Then
nv = n.nodeTypedValue
GoTo Fim
End If
Set n = node.SelectSingleNode("imposto/ICMS/ICMS50/" & strCampo)
If Not n Is Nothing Then
nv = n.nodeTypedValue
GoTo Fim
End If
Set n = node.SelectSingleNode("imposto/ICMS/ICMS51/" & strCampo)
If Not n Is Nothing Then
nv = n.nodeTypedValue
GoTo Fim
End If
Set n = node.SelectSingleNode("imposto/ICMS/ICMS60/" & strCampo)
If Not n Is Nothing Then
nv = n.nodeTypedValue
GoTo Fim
End If
Set n = node.SelectSingleNode("imposto/ICMS/ICMS70/" & strCampo)
If Not n Is Nothing Then
nv = n.nodeTypedValue
GoTo Fim
End If
Set n = node.SelectSingleNode("imposto/ICMS/ICMS90/" & strCampo)
If Not n Is Nothing Then
nv = n.nodeTypedValue
GoTo Fim
End If
Set n = node.SelectSingleNode("imposto/ICMS/ICMSSN101/" & strCampoSn)
If Not n Is Nothing Then
nv = n.nodeTypedValue
GoTo Fim
End If
Set n = node.SelectSingleNode("imposto/ICMS/ICMSSN102/" & strCampoSn)
If Not n Is Nothing Then
nv = n.nodeTypedValue
GoTo Fim
End If
Set n = node.SelectSingleNode("imposto/ICMS/ICMSSN103/" & strCampoSn)
If Not n Is Nothing Then
nv = n.nodeTypedValue
GoTo Fim
End If
Set n = node.SelectSingleNode("imposto/ICMS/ICMSSN201/" & strCampoSn)
If Not n Is Nothing Then
nv = n.nodeTypedValue
GoTo Fim
End If
Set n = node.SelectSingleNode("imposto/ICMS/ICMSSN202/" & strCampoSn)
If Not n Is Nothing Then
nv = n.nodeTypedValue
GoTo Fim
End If
Set n = node.SelectSingleNode("imposto/ICMS/ICMSSN203/" & strCampoSn)
If Not n Is Nothing Then
nv = n.nodeTypedValue
GoTo Fim
End If
Set n = node.SelectSingleNode("imposto/ICMS/ICMSSN300/" & strCampoSn)
If Not n Is Nothing Then
nv = n.nodeTypedValue
GoTo Fim
End If
Set n = node.SelectSingleNode("imposto/ICMS/ICMSSN400/" & strCampoSn)
If Not n Is Nothing Then
nv = n.nodeTypedValue
GoTo Fim
End If
Set n = node.SelectSingleNode("imposto/ICMS/ICMSSN500/" & strCampoSn)
If Not n Is Nothing Then
nv = n.nodeTypedValue
GoTo Fim
End If
Set n = node.SelectSingleNode("imposto/ICMS/ICMSSN900/" & strCampoSn)
If Not n Is Nothing Then
nv = n.nodeTypedValue
GoTo Fim
End If
Fim:
GetICMS = nv
Set n = Nothing
End Function
Function GetPIS(ByVal node As IXMLDOMNode, ByVal intCampo As Integer)
'Caso a opção intCampo seja:
'1 = CST
'2 = Aliquota PIS
'3 = Valor PIS
Dim strCampo As String
Select Case intCampo
Case 1
strCampo = "CST"
Case 2
strCampo = "pPIS"
Case 3
strCampo = "vPIS"
End Select
Dim n As IXMLDOMNode, nv
Set n = node.SelectSingleNode("imposto/PIS/PISAliq/" & strCampo)
If Not n Is Nothing Then
nv = n.nodeTypedValue
GoTo Fim
End If
Set n = node.SelectSingleNode("imposto/PIS/PISQtde/" & strCampo)
If Not n Is Nothing Then
nv = n.nodeTypedValue
GoTo Fim
End If
Set n = node.SelectSingleNode("imposto/PIS/PISNT/" & strCampo)
If Not n Is Nothing Then
nv = n.nodeTypedValue
GoTo Fim
End If
Set n = node.SelectSingleNode("imposto/PIS/PISOutr/" & strCampo)
If Not n Is Nothing Then
nv = n.nodeTypedValue
GoTo Fim
End If
Set n = node.SelectSingleNode("imposto/PIS/PISST/" & strCampo)
If Not n Is Nothing Then
nv = n.nodeTypedValue
GoTo Fim
End If
Fim:
GetPIS = nv
Set n = Nothing
End Function
Function GetCOFINS(ByVal node As IXMLDOMNode, ByVal intCampo As Integer)
'Caso a opção intCampo seja:
'1 = CST
'2 = Aliquota COFINS
'3 = Valor COFINS
Dim strCampo As String
Select Case intCampo
Case 1
strCampo = "CST"
Case 2
strCampo = "pCOFINS"
Case 3
strCampo = "vCOFINS"
End Select
Dim n As IXMLDOMNode, nv
Set n = node.SelectSingleNode("imposto/COFINS/COFINSAliq/" & strCampo)
If Not n Is Nothing Then
nv = n.nodeTypedValue
GoTo Fim
End If
Set n = node.SelectSingleNode("imposto/COFINS/COFINSQtde/" & strCampo)
If Not n Is Nothing Then
nv = n.nodeTypedValue
GoTo Fim
End If
Set n = node.SelectSingleNode("imposto/COFINS/COFINSNT/" & strCampo)
If Not n Is Nothing Then
nv = n.nodeTypedValue
GoTo Fim
End If
Set n = node.SelectSingleNode("imposto/COFINS/COFINSOutr/" & strCampo)
If Not n Is Nothing Then
nv = n.nodeTypedValue
GoTo Fim
End If
Set n = node.SelectSingleNode("imposto/COFINS/COFINSST/" & strCampo)
If Not n Is Nothing Then
nv = n.nodeTypedValue
GoTo Fim
End If
Fim:
GetCOFINS = nv
Set n = Nothing
End Function
Function GetIPI(ByVal node As IXMLDOMNode, ByVal intCampo As Integer)
'Caso a opção intCampo seja:
'1 = CST
'2 = Valor IPI
Dim strCampo As String
Select Case intCampo
Case 1
strCampo = "CST"
Case 2
strCampo = "vIPI"
End Select
Dim n As IXMLDOMNode, nv
Set n = node.SelectSingleNode("imposto/IPI/IPITrib/" & strCampo)
If Not n Is Nothing Then
nv = n.nodeTypedValue
GoTo Fim
End If
Set n = node.SelectSingleNode("imposto/IPI/IPINT/" & strCampo)
If Not n Is Nothing Then
nv = n.nodeTypedValue
GoTo Fim
End If
Fim:
GetIPI = nv
Set n = Nothing
End Function