[Resolvido]Importar XML para tabelas....fornecedor, produtos,estoque

Prezados, bom dia !

Com o sistema quase pronto para entrar em produção, eis que surge mais uma coisa.

Preciso importar  ( e aprender a desenvolver ) um  XML  e outros XML que virão,  para  4 tabelas distintas mas ligadas entre si.

Vi um bom exemplo do Fábio aqui no fórum;   Tentei adaptá-lo as minhas necessidades mas foi em vão.

Então peço, solicito ajuda aos colegas para me darem uma força.

Segue anexo uma parte do sistema que falta fazer com 2 XML.

As tabelas que precisam ser alimentadas são:

a- tblcadfornecedor.
b- tblcadproduto.
c- tblestoque.
d- tbltipo.

Desde já agradeço a ajuda e o tempo dispensado ao meu tópico.

Up.......

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

up

up

up

Mais um UP.

quinto......UPPPPPPPPPPPPPPP

6 UP

Bom, resolvi da minha maneira e modo.

Agradeço a todos que " perderam " um pouco do tempo.