[Risolto] Importare file fatture elettroniche xml

[Teo.Texaco]

Buongiorno a tutti, stavo cercando sul web un modo di importare i dati contenuti nei file xml dei corrispettivi mandati all'agenzia delle entrate e ho trovato questo argomento "che capita a fagiolo". Vuol dire che non sono il solo ad avere questo problema. Premetto che non so assolutamente nulla di macro, ed ho provato a leggere qualche manuale con risultati a dir poco deprimenti (fatico a capire i termini, figurarci a scrivere una macro). Ho provato la macro di patel e funziona bene. Avendo la necessità di importare i dati da 40 a 60 file alla volta, mi chiedevo se fosse possibile fare in modo che i dati importati non si sovrascrivessero, ma venissero inseriti nelle righe successive ogni volta che importo un file nuovo. Se poi si potesse importare più file in una volta sola sarebbe il "Top dei Top". Grazie in anticipo a chiunque avesse voglia di aiutarmi!

Editato: l'utente fa riferimento a questo post: viewtopic.php?f=9&t=10340&p=58031&hilit=xml#p58031

[charlie]

Ciao @Teo.Texaco e benvenuto sul forum.
Se intanto ti vuoi presentare, farai cosa gradita. Puoi farlo in questa sezione -> viewforum.php?f=16

L’utente che apre un quesito si impegna:

• a seguirlo dando riscontro quanto prima alle risposte ricevute nel giro di qualche giorno;
  - inserire il [Risolto] e la ✔ verde come previsto;
• rispettare le altre regole implicite del forum ( Istruzioni per nuovi arrivati - Manuale di sopravvivenza ).

In caso di inosservanza saremo costretti ad azioni di “richiamo”, sospensione o chiusura del profilo utente.

Buon proseguimento.

[Teo.Texaco]

Scusami Charlie, hai perfettamente ragione.
Ho appena rimediato!

[patel]

Putroppo la macro non è mia, mi occorre un po' di tempo per capirla e correggerla

[Teo.Texaco]

Immagino... prima di cercare di capire cosa fossero le macro, pensavo fossero una cosa semplice. Quando ho preso in mano i manuali e visto quante istruzioni ci sono per fare quella che sembra una banale operazione ci sono rimasto! Quindi, tanto di cappello a voi che me capite. Per il tempo, non ti preoccupare.... e, grazie mille dell'aiuto.

[patel]

nuova macro che sostituisce le altre

Codice: Seleziona tutto

Sub importaxml
    Dim collezione As New Collection
    Dim filterNames(0) As String
    filterNames(0) = "*.xml"
    Doc=ThisComponent
    Shs=Doc.Sheets
    Sh=Shs.getbyindex(1) ' foglio2
    'IfileStream="F:\Download\FatturaX.xml"
    IfileStream= GetAFileName(filterNames())
    if IfileStream = "" then exit sub
    iNumber = Freefile
    RigaDop = 1
    c = Sh.createCursor
    c.gotoEndOfUsedArea(false)
    LastRow = c.RangeAddress.EndRow
    if LastRow >0 then  LastRow =  LastRow + 2
    LastCol = c.RangeAddress.EndColumn
   ' Sh.getCellRangeByPosition(0, 0, LastCol, LastRow).ClearContents(1+2+4) ' Ripulisco le riprese precedenti
    rig = LastRow
    RigaDop =  LastRow + 1
    Open iFileStream For Input As iNumber 'Apre(Open) il file iFileStream per la lettura(Input)
    While Not eof(iNumber)                'eof determina la fine del file, quindi esegue le operazioni fino alla fine
      Line Input #iNumber, sLine          '
      sLine=Trim(sLine)                   'sLine è il nome della variabile che contiene i dati letti
      If sLine <>"" Then
          myarray=Split(sLine,">")        'quindi separiamo il contenuto(sLine) indicando come separatore ">"
          if ubound(myarray)=2 then       'record del tipo:             "<INTERVENTO>2182 /1</INTERVENTO>"
                                          'è diventato array del tipo: ("<INTERVENTO";"2182 /1</INTERVENTO")
             intCol = Right(myarray(0), Len(myarray(0))-1) 'INTERVENTO(Intestazione di colonna)
             DatiCol = Left(myarray(1), Len(myarray(1))-Len(IntCol)-2) ' Dati estratti
             On Error Goto doppione
                collezione.Add(intCol,intCol)
                oRanges = ThisComponent.NamedRanges
                If NOT oRanges.hasByName(intCol) Then
                       oCellAddress = Sh.GetCellByPosition(i, rig).getCellAddress
                       oRanges.addNewByName(intCol, Sh.GetCellByPosition(i, rig).AbsoluteName, oCellAddress, 0) ' inserisco nome definito colonna
                End if
                Sh.GetCellByPosition(i, lastrow).String = intCol
                Sh.GetCellByPosition(i, lastrow+1).String = DatiCol
                i = i + 1                 'indice di colonna
           end if
      End If
Ric:
    wend
   
    Close #iNumber
    REM Elimino tutti i nomi definiti
    oRanges = ThisComponent.NamedRanges
    for i = oRanges.Count -1 To 0 Step -1
        oRanges.removebyname(oRanges.ElementNames(i))
    next i
    Exit sub             
doppione:
    If intCol = Sh.GetCellRangeByName("A" & LastRow + 1).String Then RigaDop = RigaDop + 1
    colonna = Sh.GetCellRangeByName(intCol).getCellAddress.column
    Sh.GetCellByPosition(colonna, RigaDop).String = DatiCol
    Resume Ric:
                   
End Sub


Function GetAFileName(Filternames()) As String
Dim oFileDialog as Object, iAccept as Integer, sPath as String, InitPath as String
Dim RefControlName as String, oUcb as object
GlobalScope.BasicLibraries.LoadLibrary("Tools")
oFileDialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
AddFiltersToDialog(FilterNames(), oFileDialog)
InitPath = ConvertToUrl("F:\Download")
If InitPath = "" Then
  InitPath = GetPathSettings("Work")
End If
If oUcb.Exists(InitPath) Then
  oFileDialog.SetDisplayDirectory(InitPath)
End If
iAccept = oFileDialog.Execute()
If iAccept = 1 Then
  sPath = oFileDialog.Files(0)
  GetAFileName = sPath
End If
oFileDialog.Dispose()
End Function

[Teo.Texaco]

Grazie mille dell'aiuto Patel... sei stato veloce, altro che un pò di tempo! Ho provato la macro, adesso importa i dati da file senza sovrascrivere, benissimo! Già così è un grosso aiuto. Mi chiedevo se non esiste una funzione che permetta di importare i dati da più file contemporaneamente, in una volta sola. Se si potesse aggiungere anche questo miglioramento sarebbe il Top, una comodità che farebbe risparmiare un bel pò di tempo nell'elaborazione dei dati dell'agenzia delle entrate.

[patel]

intendi tutti i file di una cartella ? allega qualche file xml per poter fare test.

[Teo.Texaco]

Si, o tutti i file di una cartella o anche solo una parte. Allego un archivio rar contenente la cartella con i file. I dati sensibili contenuti nei file sono già stati modificati.

[patel]

Come ti ho detto la macro non è mia, il meglio che ho potuto fare è questo

Codice: Seleziona tutto

Sub ApriFattureInCartella
Dim  dummy()

Doc=ThisComponent
Sh=Doc.Sheets(1)
sPath ="F:\Download\B\"  ' cartella con i file
sFileName = Dir(sPath, 0)
Dim collezione As New Collection
Do While (sFileName <> "")
	n = collezione.Count()
	for i = n to 1 step -1
		collezione.remove(i)
	next
    DocUrl = ConvertToURL(sPath & sFileName) 
'    print DocUrl
    iNumber = Freefile
    c = Sh.createCursor
    c.gotoEndOfUsedArea(false)
    LastRow = c.RangeAddress.EndRow
    if LastRow >0 then  LastRow =  LastRow + 2
    LastCol = c.RangeAddress.EndColumn
    rig = LastRow
    RigaDop =  LastRow + 1
    Open DocUrl For Input As iNumber 'Apre(Open) il file iFileStream per la lettura(Input)
    While Not eof(iNumber)                'eof determina la fine del file, quindi esegue le operazioni fino alla fine
      Line Input #iNumber, sLine          '
      sLine=Trim(sLine)                   'sLine è il nome della variabile che contiene i dati letti
      If sLine <>"" Then

          myarray=Split(sLine,">")        'quindi separiamo il contenuto(sLine) indicando come separatore ">"
          if ubound(myarray)=2 then       'record del tipo:             "<INTERVENTO>2182 /1</INTERVENTO>"
                                          'è diventato array del tipo: ("<INTERVENTO";"2182 /1</INTERVENTO")
             intCol = Right(myarray(0), Len(myarray(0))-1) 'INTERVENTO(Intestazione di colonna)
             DatiCol = Left(myarray(1), Len(myarray(1))-Len(IntCol)-2) ' Dati estratti
             On Error Goto doppione
                collezione.Add(intCol,intCol)
                oRanges = ThisComponent.NamedRanges
                If NOT oRanges.hasByName(intCol) Then
                       oCellAddress = Sh.GetCellByPosition(i, rig).getCellAddress
                       oRanges.addNewByName(intCol, Sh.GetCellByPosition(i, rig).AbsoluteName, oCellAddress, 0) ' inserisco nome definito colonna
                End if
                Sh.GetCellByPosition(i, lastrow).String = intCol
                Sh.GetCellByPosition(i, lastrow+1).String = DatiCol
                i = i + 1                 'indice di colonna
           end if
      End If
Ric:
    wend
   
    Close #iNumber
    REM Elimino tutti i nomi definiti
    oRanges = ThisComponent.NamedRanges
    for i = oRanges.Count -1 To 0 Step -1
        oRanges.removebyname(oRanges.ElementNames(i))
    next i
   Goto continua       
doppione:
    If intCol = Sh.GetCellRangeByName("A" & LastRow + 1).String Then RigaDop = RigaDop + 1
    colonna = Sh.GetCellRangeByName(intCol).getCellAddress.column
    Sh.GetCellByPosition(colonna, RigaDop).String = DatiCol
    Resume Ric:
continua:
sFileName = Dir()

Loop
End Sub

[Teo.Texaco]

Va benissimo, tranquillo.... mettere le mani su un lavoro iniziato da altri è sempre complicato. Ho copiato la macro e l'ho sostituita a quella precedente, purtroppo mi da un messaggio d'errore che allego. A te funzionava?
E' possibile che l'errore sia dovuto ad un mio sbaglio nell'inserire la macro? Ho notato che con questa modifica, nel modulo 1 vedo solo una macro, mentre nella versione precedente erano presenti 2 macro. E' possibile che il messaggio d'errore sia dovuto a questo?

[patel]

la macro è una sola perché la scelta del file da scaricare non serve più, la cartella da cui scaricare è nel codice, se non risolvi allega il tuo file ods

[Teo.Texaco]

Ciao Patel, scusa se non ti ho risposto in tempi brevi. Ho provato anche a cambiare l'url della cartella nel codice con quello della cartella sul mio pc, ma non cambia nulla: mi da lo stesso messaggio d'errore. Ti allego il file di Calc che sto usando attualmente. Anche in questo file ho già alterato i dati sensibili.

[patel]

il pulsante che hai creato punta ad una macro diversa, devi cambiare il nome alla sub adeguandolo a quello chiamato dal pulsante

[Teo.Texaco]

Hai ragione, scusa. Ho modificato la macro ma non il pulsante. Adesso il messaggio d'errore non lo da più, ma comunque non riesco a farla funzionare. Dopo che premo il pulsante e provo ad aprire il foglio 2 mi si blocca calc e devo chiuderlo. Ho provato anche ad aspettare per 10 minuti, ma non si sblocca. Allego il file

[patel]

hai ragione, con open office lo fa anche a me, io uso LibreOffice e te lo consiglio.
L'errore avviene qui

Codice: Seleziona tutto

   n = collezione.Count()
   for i = n to 1 step -1
      collezione.remove(i)
   next

[patel]

La macro corretta che funziona con ambedue gli ambienti è questa

Codice: Seleziona tutto

Sub ApriFattureInCartella
Dim  dummy()

Doc=ThisComponent
Sh=Doc.Sheets(1)
sPath ="F:\Download\B\"  ' cartella con i file
sFileName = Dir(sPath, 0)
Dim collezione As New Collection
Do While (sFileName <> "")
    col=0 '<<<<<<<<<<<< colonna iniziale
    set collezione = New Collection '<<<<<<<<<<<<
    DocUrl = ConvertToURL(sPath & sFileName)
    iNumber = Freefile
    c = Sh.createCursor
    c.gotoEndOfUsedArea(false)
    LastRow = c.RangeAddress.EndRow
    if LastRow >0 then  LastRow =  LastRow + 2
    LastCol = c.RangeAddress.EndColumn
    rig = LastRow
    RigaDop =  LastRow + 1
    Open DocUrl For Input As iNumber 'Apre(Open) il file iFileStream per la lettura(Input)
    While Not eof(iNumber)                'eof determina la fine del file, quindi esegue le operazioni fino alla fine
      Line Input #iNumber, sLine          '
      sLine=Trim(sLine)                   'sLine è il nome della variabile che contiene i dati letti
      If sLine <>"" Then

          myarray=Split(sLine,">")        'quindi separiamo il contenuto(sLine) indicando come separatore ">"
          if ubound(myarray)=2 then       'record del tipo:             "<INTERVENTO>2182 /1</INTERVENTO>"
                                          'è diventato array del tipo: ("<INTERVENTO";"2182 /1</INTERVENTO")
             intCol = Right(myarray(0), Len(myarray(0))-1) 'INTERVENTO(Intestazione di colonna)
             DatiCol = Left(myarray(1), Len(myarray(1))-Len(IntCol)-2) ' Dati estratti
             On Error Goto doppione
                collezione.Add(intCol,intCol)
                oRanges = ThisComponent.NamedRanges
                If NOT oRanges.hasByName(intCol) Then
                       oCellAddress = Sh.GetCellByPosition(col, rig).getCellAddress
                       oRanges.addNewByName(intCol, Sh.GetCellByPosition(col, rig).AbsoluteName, oCellAddress, 0) ' inserisco nome definito colonna
                End if
                Sh.GetCellByPosition(col, lastrow).String = intCol
                Sh.GetCellByPosition(col, lastrow+1).String = DatiCol
                col = col + 1                 'indice di colonna
           end if
      End If
Ric:
    wend
   
    Close #iNumber
    REM Elimino tutti i nomi definiti
    oRanges = ThisComponent.NamedRanges
    for n = oRanges.Count -1 To 0 Step -1
        oRanges.removebyname(oRanges.ElementNames(n))
    next n
   Goto continua       
doppione:
    If intCol = Sh.GetCellRangeByName("A" & LastRow + 1).String Then RigaDop = RigaDop + 1
    colonna = Sh.GetCellRangeByName(intCol).getCellAddress.column
    Sh.GetCellByPosition(colonna, RigaDop).String = DatiCol
    Resume Ric:
continua:
sFileName = Dir()

Loop
End Sub

[Teo.Texaco]

Patel, grazie mille! Adesso funziona perfettamente. Per me così è ottima.
Un miglioramento, per rendere questo bel lavoro fruibile a chiunque, anche a chi non sappia niente di informatica (e non sa come fare a inserire l'URL della cartella), sarebbe predisporre nella macro una finestra pop-up che ti chieda di selezionare la cartella dove trovare i files da importare.
Ma ripeto.... io già così, ho risolto i miei problemi e sono a posto. Di nuovo grazie!!

[patel]

per scegliere la cartella puoi usare questa

Codice: Seleziona tutto

Sub Main
seldir = getFolder("scegli", ConvertToUrl("C:\Documenti"))
print seldir
End Sub
Function getFolder(sTitle AS String, optional sInitDir) AS String
   oPicker = CreateUnoService("com.sun.star.ui.dialogs.FolderPicker")
   oPicker.setTitle(sTitle)
   if not ismissing(sInitDir) then oPicker.setDisplayDirectory(sInitDir)
   if oPicker.execute() then getFolder = oPicker.getDirectory()
End Function

[Teo.Texaco]

Ho provato ad integrare la macro con la scelta della cartella... purtroppo non sono bravo come te
Ti allego il file ods perchè non so come allegare solo lo script della macro. Prova a vedere cosa ho sbagliato.
Abbi pazienza ma è la mia prima esperienza con le macro.

[patel]

Hai fatto tutto correttamente, solo devi aggiungere una barra al nome della cartella per comporre correttamente il nome del file
sPath = seldir & "/"

[Teo.Texaco]

Azz.. avevo capito che il problema era la / ma avevo fatto delle prove senza & e ". Adesso funziona alla perfezione!
Allego il file ods completamente funzionante nel caso servisse a qualcun altro.
Ancora un grazie grande come una casa a patel per l'aiuto e la pazienza di starmi dietro!

Ps. una raccomandazione ad eventuali utilizzatori del file. Se non volete vedere messaggi strani di errore è buona cosa che la cartella contenga solo file XML. Controllate sempre che il numero di letture siano uguali al numero di file da importare.... non si sa mai!!

[Celext]

Ciao a tutti, vorrei ringraziare Teo e Patel per la condivisione del file. Vorrei chiedere se fosse possibile estrarre il contenuto di ogni file xml in una unica cella anzichè come avviene nella versione attuale.
Grazie

[patel]

Non capisco, potresti allegare un esempio ?

[Celext]

Ciao Patel, ho allegato due files di esempio.
Grazie

[patel]

quindi nella cella A1 vuoi semplicemente il testo del file xml senza farci operazioni ? se è così prova questa

Codice: Seleziona tutto

Sub ApriFatture_InCartella
seldir = getFolder("scegli", ConvertToUrl("C:\Documenti"))
Dim  dummy()
Doc=ThisComponent
Sh=Doc.Sheets(1)
sPath = seldir & "/"  ' cartella con i file
sFileName = Dir(sPath, 0)
Dim collezione As New Collection
Do While (sFileName <> "")
    row=0 '<<<<<<<<<<<< riga iniziale
    DocUrl = ConvertToURL(sPath & sFileName)
    iNumber = Freefile
    Open DocUrl For Input As iNumber 'Apre(Open) il file iFileStream per la lettura(Input)
    While Not eof(iNumber)                'eof determina la fine del file, quindi esegue le operazioni fino alla fine
      Line Input #iNumber, sLine          '
      sLine=Trim(sLine)                   'sLine è il nome della variabile che contiene i dati letti
      If sLine <>"" Then
                Sh.GetCellByPosition(0, riga).String =  sline
                riga = riga + 1                 'indice di riga
      End If
    wend
     Close #iNumber
sFileName = Dir()
Loop
End Sub

[Celext]

Ciao Patel, ti ringrazio per la tua risposta. Quello che vorrei ottenere io è:

l'intero contenuto del file in cella A1, l'intero contenuto del file successivo in cella A2 e cosi fino alla fine della lettura di tutti i file di quella cartella.

Scusami credo di non avere spiegato bene nel primo messaggio.

Grazie attendo tuo riscontro.

[patel]

ho modificato il codice sopra riportato

[Celext]

Grazie Patel, meglio di prima ma il testo viene ripartito su più celle in verticale, vedi screenshot allegato. É possibile avere tutto il testo di ogni singolo file in una cella?
Grazie per la pazienza

[patel]

Ma tu come hai fatto per costruire l'esempio ?