Rieccomi
Ho modificato il codice, spero, come suggerito da AIKA:
Public Function ImportaRigheAnno() 'Massivo Anno
Dim StartPath As String, NomeFile, FullPath As String, strsql As String, MyAnno As Integer, NrLinee As Integer, i As Integer, Testo As String
Dim db As DAO.Database
Dim rs1 As DAO.Recordset, rs2 As DAO.Recordset
MyAnno = DLookup("Esercizio", "TbAvvio")
On Error Resume Next
'On Error GoTo GestErr
'seleziona la riga unica Lato 1
DBEngine(0)(0).Execute "Delete TbFileRigheFattForn.IdPrimaNota FROM TbFileRigheFattForn;"
strsql = "SELECT IdPrimaNota, IdSezione, AnnoF, NomeFile " & _
"FROM TbPrimaNota " & _
"WHERE TbPrimaNota.AnnoF=" & MyAnno & "and IdSezione=" & 1
Set rs1 = CurrentDb.OpenRecordset(strsql)
rs1.MoveFirst
Do Until rs1.EOF
NomeFile = (rs1!NomeFile) 'Prelevo dalla tabella il nome del file da elaborare
StartPath = Application.CurrentProject.Path & "\XML\FattureFornitoriArchiviate\" 'Prelevo dalla tabella il percorso del file da elaborare
FullPath = StartPath & NomeFile 'Compongo il percorso completo
'Debug.Print FullPath
'==========================================================================================
'INIZIO LETTURA FILE XML ## dati di righe solo i Dieci nodi
'==========================================================================================
Dim obj As DOMDocument
Dim Verifica As Boolean
Dim Nodo As IXMLDOMNodeList
Dim Nome As IXMLDOMNode
Dim dettaglioLinee As IXMLDOMNodeList
Dim lineaDettaglio As IXMLDOMNode
Dim NumeroLinea As IXMLDOMNode, CodiceArticolo As IXMLDOMNode, Descrizione As IXMLDOMNode, Quantita As IXMLDOMNode, UnitaMisura As IXMLDOMNode
Dim PrezzoUnitario As IXMLDOMNode, ScontoMaggiorazione As IXMLDOMNode, PrezzoTotale As IXMLDOMNode, AliquotaIva As IXMLDOMNode
'==========================================================================================
'ACCESSO AL FILE XML
'==========================================================================================
Set obj = New DOMDocument
obj.async = False
obj.Load (FullPath)
Set dettaglioLinee = obj.documentElement.selectNodes("//DatiBeniServizi/DettaglioLinee")
For Each lineaDettaglio In dettaglioLinee
Set NumeroLinea = NumeroLinea.selectSingleNode("./NumeroLinea")
Debug.Print NumeroLinea.Text
Set CodiceArticolo = lineaDettaglio.selectSingleNode("./CodiceArticolo")
Debug.Print CodiceArticolo.Text
Set Descrizione = lineaDettaglio.selectSingleNode("./Descrizione")
Debug.Print Descrizione.Text
Set Quantita = lineaDettaglio.selectSingleNode("./Quantita")
Debug.Print Quantita.Text
Set UnitaMisura = lineaDettaglio.selectSingleNode("./UnitaMisura")
Debug.Print UnitaMisura.Text
Set PrezzoUnitario = lineaDettaglio.selectSingleNode("./PrezzoUnitario")
Debug.Print PrezzoUnitario.Text
Set ScontoMaggiorazione = lineaDettaglio.selectSingleNode("./ScontoMaggiorazione")
Debug.Print ScontoMaggiorazione.Text
Set PrezzoTotale = lineaDettaglio.selectSingleNode("./PrezzoTotale")
Debug.Print PrezzoTotale.Text
Set AliquotaIva = lineaDettaglio.selectSingleNode("./AliquotaIVA")
Debug.Print AliquotaIva.Text
Next
Set obj = Nothing
Set rs2 = CurrentDb.OpenRecordset("TbFileRigheFattForn", dbOpenDynaset) 'Recordset per popolare il Lato Molti
With rs2
.AddNew
.Fields("IdPrimaNota") = (rs1!IdPrimaNota)
.Fields("NumeroLinea") = Trim(NumeroLinea.Text)
.Fields("CodiceArticolo") = Trim(CodiceArticolo.Text)
.Fields("Descrizione") = Trim(Descrizione.Text)
.Fields("Quantita") = Replace(Quantita.Text, ".", ",")
.Fields("UnitaMisura") = Trim(UnitaMisura.Text)
.Fields("PrezzoUnitario") = Replace(PrezzoUnitario.Text, ".", ",")
.Fields("ScontoMaggiorazione") = Replace(ScontoMaggiorazione.Text, ".", ",")
.Fields("PrezzoTotale") = Replace(PrezzoTotale.Text, ".", ",")
.Fields("AliquotaIVA") = Replace(AliquotaIva.Text, ".", ",")
.Update
.MoveNext
'DoEvents
End With
rs1.MoveNext
'Debug.Print FullPath
Loop
'==========================================================================================
' Chiusura e distruzione recordset
'==========================================================================================
rs1.Close
Set rs1 = Nothing
rs2.Close
Set rs2 = Nothing
'==========================================================================================
MsgBox "Righe Estratte!", vbInformation
End Function
Superato il problema che si creava: nel caso un nodo fosse assente il record non veniva estratto.
Ora atteso che dal Lato 1 vi sono 26 documenti e che il lato molti contiene le righe che estraiamo dal xml in questione
si verifica che le righe (da debug vengono estratti regolarmente -se nodo assente la riga viene estratta)
mentre nel recordset della Tab di destinazione viene esportata solo la 1°Riga di tutti i 26 documenti.
Sicuramente sto sbagliando qualcosa in questa parte di codice...ma in questo momento sono fuso e non riesco a capire dove stà l'errore:
Set rs2 = CurrentDb.OpenRecordset("TbFileRigheFattForn", dbOpenDynaset) 'Recordset per popolare il Lato Molti
With rs2
.AddNew
.Fields("IdPrimaNota") = (rs1!IdPrimaNota)
.Fields("NumeroLinea") = Trim(NumeroLinea.Text)
.Fields("CodiceArticolo") = Trim(CodiceArticolo.Text)
.Fields("Descrizione") = Trim(Descrizione.Text)
.Fields("Quantita") = Replace(Quantita.Text, ".", ",")
.Fields("UnitaMisura") = Trim(UnitaMisura.Text)
.Fields("PrezzoUnitario") = Replace(PrezzoUnitario.Text, ".", ",")
.Fields("ScontoMaggiorazione") = Replace(ScontoMaggiorazione.Text, ".", ",")
.Fields("PrezzoTotale") = Replace(PrezzoTotale.Text, ".", ",")
.Fields("AliquotaIVA") = Replace(AliquotaIva.Text, ".", ",")
.Update
.MoveNext
'DoEvents
End With
rs1.MoveNext
'Debug.Print FullPath
Loop
'==========================================================================================
' Chiusura e distruzione recordset
'==========================================================================================
rs1.Close
Set rs1 = Nothing
rs2.Close
Set rs2 = Nothing
Qualcuno può aiutarmi? grazie anticipate