Ciao Nicola,
In attesa che il grande e gentile Norman, mi fornisca il suo prezioso aiuto, ho continuato con le ricerche in rete ed ho notato questo codice che penso, sia adatto alla mia reale esigenza, lo posto.
Ciò che desidero capire con la vostra professionale esperienza, è come poter richiamare i nodi del file xml postato all'interno di questa routine al fine di poter agire in autonomia e poter capire da solo la logica della routine postata.
Public Sub ImportXML()
Dim fd As Office.FileDialog: Set fd = Application.FileDialog(msoFileDialogFilePicker)
Dim xdoc As Object: Set xdoc = CreateObject("MSXML2.DOMDocument")
With fd
.Filters.Clear
.Title = "Select Multiple XML Files"
.Filters.Add "XML File", "*.xml", 1
.AllowMultiSelect = True
If .Show = True Then
xdoc.async = False: xdoc.validateOnParse = False
row_number = 1
For i = 1 To .SelectedItems.Count
xmlFileName = fd.SelectedItems(i)
xdoc.Load (xmlFileName)
Set Products = xdoc.DocumentElement
For Each Product In Products.ChildNodes
Application.Range("ProductsRange").Cells(row_number, 1).Value = Product.ChildNodes(0).Text
Application.Range("ProductsRange").Cells(row_number, 2).Value = Product.ChildNodes(1).Text
Application.Range("ProductsRange").Cells(row_number, 3).Value = Product.ChildNodes(2).Text
Application.Range("ProductsRange").Cells(row_number, 4).Value = Product.ChildNodes(3).Text
Application.Range("ProductsRange").Cells(row_number, 5).Value = Product.ChildNodes(4).Text
Application.Range("ProductsRange").Cells(row_number, 6).Value = Product.ChildNodes(5).Text
Application.Range("ProductsRange").Cells(row_number, 7).Value = Product.ChildNodes(6).Text
Application.Range("ProductsRange").Cells(row_number, 8).Value = Product.ChildNodes(7).Text
Application.Range("ProductsRange").Cells(row_number, 9).Value = Product.ChildNodes(8).Text
Application.Range("ProductsRange").Cells(row_number, 10).Value = Product.ChildNodes(9).Text
Application.Range("ProductsRange").Cells(row_number, 11).Value = Product.ChildNodes(10).Text
row_number = row_number + 1
Next Product
Next i
End If
End With
End Sub
Innanzitutto, ho notato alcuni problemi con il file xml che mi hai inviato. Puoi confermare tali problemi provando a eseguire il codice che hai pubblicato nel tuo post iniziale, utilizzando questo file xml come origine dati. Sembrerebbe quindi che i dati nei file di fattura xml non siano sempre coerenti.
Per questo motivo, ho deciso di seguire un'altra strada e, pertanto, prova qualcosa del genere:
'========>>
Option Explicit
'-------->>
Public Sub Tester()
Dim srcWB As Workbook, destWb As Workbook
Dim srcSH As Worksheet, destSH As Worksheet
Dim srcRng As Range, destRng As Range
Dim FD As FileDialog
Dim vFile As Variant
Dim LRow As Long
Const sFoglio\_Destinazione As String = **"Report" '<<=== Modifica**
Set destWb = ThisWorkbook
With destWb
If SheetExists(sFoglio\_Destinazione, destWb) Then
Set destSH = .Sheets(sFoglio\_Destinazione)
With destSH
Intersect(.Rows(2).Resize(.Rows.Count - 1), .UsedRange).ClearContents **'\\ Cancella se vuoi ritenere i dati precedenti!**
End With
Else
Set destSH = .Sheets.Add(Before:=.Sheets(1))
destSH.Name = sFoglio\_Destinazione
End If
End With
With destSH
LRow = LastRow(destSH, .Columns("A")) ':BF"))
Set destRng = .Range("A" & LRow + 1)
End With
Set FD = Application.FileDialog(msoFileDialogFilePicker)
With FD
FD.Title = "Seleziona i file"
.InitialFileName = "C:\Users\Nicola\"
.Filters.Clear
.Filters.Add "XML", "\*.xml"
.Filters.Add "File XML", "\*.xml"
If .Show = -1 Then
On Error GoTo XIT
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
For Each vFile In .SelectedItems
Set srcWB = Workbooks.OpenXML(Filename:=vFile, LoadOption:=xlXmlLoadImportToList)
Set srcSH = srcWB.Sheets(1)
Set srcRng = srcSH.Rows(1)
srcRng.Copy Destination:=destRng
Set destRng = destRng.Offset(1)
srcWB.Close SaveChanges:=False
Next vFile
Else
Call MsgBox(Prompt:="Non hai selezionato alcun file !", \_
Buttons:=vbCritical, \_
Title:="REPORT")
GoTo XIT
End If
End With
destSH.UsedRange.EntireColumn.AutoFit
Call MsgBox(Prompt:="Fatto", \_
Buttons:=vbInformation, \_
Title:="REPORT")
XIT:
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub
'--------->>
Public Function LastRow(SH As Worksheet, _
Optional Rng As Range, \_
Optional minRow As Long = 1)
If Rng Is Nothing Then
Set Rng = SH.Cells
End If
On Error Resume Next
LastRow = Rng.Find(What:="\*", \_
After:=Rng.Cells(1), \_
Lookat:=xlPart, \_
LookIn:=xlFormulas, \_
SearchOrder:=xlByRows, \_
SearchDirection:=xlPrevious, \_
MatchCase:=False).Row
On Error GoTo 0
If LastRow < minRow Then
LastRow = minRow
End If
End Function
'--------->>
Public Function SheetExists(sSheetName As String, _
Optional ByVal WB As Workbook) As Boolean
On Error Resume Next
If WB Is Nothing Then
Set WB = ThisWorkbook
End If
SheetExists = CBool(Len(WB.Sheets(sSheetName).Name))
End Function
'<<========
Credo che il codice sia in gran parte autoesplicativo, ma, se hai bisogno di delucidazioni, chiedi pure.
===
Regards,
Norman
![](data:image/svg+xml, %3Csvg xmlns='http://www.w3.org/2000/svg' height='64' class='font-weight-bold' style='font: 600 30.11764705882353px "SegoeUI", Arial' width='64'%3E%3Ccircle fill='hsl(128, 8%, 22%)' cx='32' cy='32' r='32' /%3E%3Ctext x='50%25' y='55%25' dominant-baseline='middle' text-anchor='middle' fill='%23FFF' %3EA%3C/text%3E%3C/svg%3E)
