Bem como não houve retorno ao meu tópico para me ajudar...estou mexendo no código desde que postei a duvida, vamos ao meu progresso.
Public Function ImportaXML(LocalXml As String)
'---------------------------------------------------------------'
' Criado por FabioPaes '
' Em 12/02/2017 para MAXIMOACCESS '
' Em caso de correçoes reportar a origem para atualizar o codigo'
'---------------------------------------------------------------'
Dim doc As DOMDocument
Dim xDet As IXMLDOMNodeList
Dim NomeArq As String
Dim DB As Database
Dim rsFor, rsProd, rsCompra, rsCompDet As DAO.Recordset
Dim xProd As String
Dim i, x, regAtual As Integer
DoCmd.OpenForm "frmAguarde"
Forms!frmaguarde!txt2 = "Xml Com Erros:"
Diret = LocalXml
NomeArq = Dir(Diret & "*.XML", vbArchive)
Set DB = CurrentDb()
Set doc = New DOMDocument
'Buscará todos os arquivos com extenção .xml da pasta selecionada
Do While NomeArq <> ""
doc.Load (LocalXml & NomeArq) 'Pega a Pasta e o Nome do primeiro arquivo....
'Verifica se o Arquivo foi aberto corretamente e se possui chave. Se possuir importa, se nao Pula pra o Proximo!
If doc.validate.errorCode = -1072897500 And (doc.getElementsByTagName("chNFe").length) Then
Set xDet = doc.getElementsByTagName("det")
'------------------------------------------------------------------------'
'Insere os Dados do Fornecedor, se nao for Cadastrado.
Set rsFor = DB.OpenRecordset("TblCadFornecedor")
x = Nz(DLookup("IdFornecedor", "TblCadFornecedor", "Cnpj = '" & doc.getElementsByTagName("CNPJ")(0).Text & "'"), 0) 'X buscará o fornecedor na tabela "tbFornecedores"
If x <= 0 Then 'Se x for <=0 significa que nao ta cadastrado, entao irá cadastrar o fornecedor
rsFor.AddNew
rsFor!Fornecedor = doc.getElementsByTagName("xNome")(0).Text
rsFor!NomeFantasia = doc.getElementsByTagName("xFant")(0).Text
rsFor!Endereco = doc.getElementsByTagName("xLgr")(0).Text
rsFor!Numero = doc.getElementsByTagName("nro")(0).Text
rsFor!Bairro = doc.getElementsByTagName("xBairro")(0).Text
rsFor!CEP = doc.getElementsByTagName("CEP")(0).Text
rsFor!Cidade = doc.getElementsByTagName("xMun")(0).Text
rsFor!Estado = doc.getElementsByTagName("UF")(0).Text
rsFor!FoneComercial = doc.getElementsByTagName("fone")(0).Text
rsFor!CNPJ = doc.getElementsByTagName("CNPJ")(0).Text
rsFor!InscrEstadual = doc.getElementsByTagName("IE")(0).Text
rsFor.Update
'Apos cadastrar o fornecedor, x buscara o ID desse fornecedor para ser utilizado na importação do xml em questao
x = Nz(DLookup("IdFornecedor", "TblCadFornecedor", "Cnpj = '" & doc.getElementsByTagName("CNPJ")(0).Text & "'"), 0)
rsFor.Close
Set rsFor = Nothing
End If
' Dados dos Produtos
i = 0
xProd = ""
'Aqui é o Loop que percorrerá pela Tag "det" que são os produtos..
'Buscara produto a produto, e o inserirá na nota que esta sendo importada
For Each det In xDet
xProd = doc.getElementsByTagName("det")(i).XMl ' xProd desmembrará o xml pegando produto a produto...
x = Nz(DLookup("IdProduto", "TblCadProduto", "Produto = '" & separaEntreDuasStringsXML(xProd, "", "") & "'"), 0)
If x <= 0 Then
'Cadastra o Produto, pois ainda nao foi cadastrado
Set rsProd = DB.OpenRecordset("TblCadProduto")
rsProd.AddNew
rsProd!Fornecedor = doc.getElementsByTagName("xNome")(0).Text ' fornecedor
rsProd!Produto = separaEntreDuasStringsXML(xProd, "", "") ' descrição do produto
rsProd!TipoOculta = separaEntreDuasStringsXML(xProd, "", "") 'tipo
rsProd!CodBarras = separaEntreDuasStringsXML(xProd, "", "") ' codigo de barrras
rsProd!Preco = separaEntreDuasStringsXML(xProd, "", "") ' preço por unidade
rsProd.Update
x = Nz(DLookup("IdProduto", "TblEstoque", "Produto = '" & separaEntreDuasStringsXML(xProd, "", "") & "'"), 0)
'Insere o produto cadastrado no estoque
Set rsCompDet = DB.OpenRecordset("TblEstoque")
rsCompDet.AddNew
rsCompDet!IdEstoque = regAtual
rsCompDet!IdProduto = x
rsCompDet!QtdEntrada = Replace(separaEntreDuasStringsXML(xProd, "", ""), ".", ",")
rsCompDet.Update
rsCompDet.Close
rsProd.Close
Set rsCompDet = Nothing
Set rsProd = Nothing
obs...até aqui está quase 100 por cento, estou tendo dificuldades para acertar a entrada no estoque, ele diz que não há registro atual, mas tem...tem pelo menos um na tabela cadastro de produtos
Else
Set rsProd = DB.OpenRecordset("SELECT * FROM TblEstoque WHERE IdProduto = " & x & "")
rsProd.Edit 'Atualiza o estoque do produto
rsProd!Saldo = rsProd!Saldo + Replace(separaEntreDuasStringsXML(xProd, "", ""), ".", ",")
rsProd.Update
'Limpa os dados do recordset e fecha a conecção
rsCompDet.Close
rsProd.Close
Set rsCompDet = Nothing
Set rsProd = Nothing
End If
'Add 1 unidade ao contador para pegar o proximo produto
i = i + 1
Next
Else
'Se abrir xml com erro, será add no formulario "aguarde" o nome dele
Forms!frmaguarde!txt2 = Forms!frmaguarde!txt2 & vbNewLine & NomeArq
Forms!frmaguarde.Requery
End If
'Loop dos arquivos, pega o proximo arquivo
NomeArq = Dir()
Loop
Forms!FrmCadProduto.Requery
MsgBox "Todos os XMLs da pasta selecionada Foram Importados com Sucesso! " & vbNewLine & "Verifique as Notas lançadas!!!", vbInformation, "Sucesso!!!"
DB.Close
Set DB = Nothing
End Function