Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]
Groups > it.comp.lang.visual-basic > #19729 > unrolled thread
| Started by | sal21 <gss.italy@iol.it> |
|---|---|
| First post | 2020-03-15 11:36 -0700 |
| Last post | 2020-03-18 17:51 +0100 |
| Articles | 20 on this page of 21 — 4 participants |
Back to article view | Back to it.comp.lang.visual-basic
RIBA in formato xml iso 20022 sal21 <gss.italy@iol.it> - 2020-03-15 11:36 -0700
Re: RIBA in formato xml iso 20022 "Sauro" <vicchi@crsscala.it> - 2020-03-17 13:20 +0100
Re: RIBA in formato xml iso 20022 RobertoA <amorosik@tiscalinet.it> - 2020-03-17 13:57 +0100
Re: RIBA in formato xml iso 20022 "Sauro" <vicchi@crsscala.it> - 2020-03-18 17:50 +0100
Re: RIBA in formato xml iso 20022 sal21 <gss.italy@iol.it> - 2020-03-18 10:44 -0700
Re: RIBA in formato xml iso 20022 "Sauro" <vicchi@crsscala.it> - 2020-03-19 11:58 +0100
Re: RIBA in formato xml iso 20022 RobertoA <amorosik@tiscalinet.it> - 2020-03-19 14:10 +0100
Re: RIBA in formato xml iso 20022 "Sauro" <vicchi@crsscala.it> - 2020-03-19 17:41 +0100
Re: RIBA in formato xml iso 20022 "Sauro" <vicchi@crsscala.it> - 2020-03-20 08:48 +0100
Re: RIBA in formato xml iso 20022 "Sauro" <vicchi@crsscala.it> - 2020-03-19 12:06 +0100
Re: RIBA in formato xml iso 20022 "Sauro" <vicchi@crsscala.it> - 2020-03-19 12:07 +0100
Re: RIBA in formato xml iso 20022 "Sauro" <vicchi@crsscala.it> - 2020-03-19 13:06 +0100
Re: RIBA in formato xml iso 20022 sal21 <gss.italy@iol.it> - 2020-03-17 08:24 -0700
Re: RIBA in formato xml iso 20022 Greg <greg@alicie.com> - 2020-03-17 20:44 +0100
Re: RIBA in formato xml iso 20022 sal21 <gss.italy@iol.it> - 2020-03-17 14:38 -0700
Re: RIBA in formato xml iso 20022 "Sauro" <vicchi@crsscala.it> - 2020-03-19 11:53 +0100
Re: RIBA in formato xml iso 20022 "Sauro" <vicchi@crsscala.it> - 2020-03-19 18:25 +0100
Re: RIBA in formato xml iso 20022 sal21 <gss.italy@iol.it> - 2020-03-19 13:32 -0700
Re: RIBA in formato xml iso 20022 "Sauro" <vicchi@crsscala.it> - 2020-03-19 18:25 +0100
Re: RIBA in formato xml iso 20022 "Sauro" <vicchi@crsscala.it> - 2020-03-19 18:26 +0100
Re: RIBA in formato xml iso 20022 "Sauro" <vicchi@crsscala.it> - 2020-03-18 17:51 +0100
Page 1 of 2 [1] 2 Next page →
| From | sal21 <gss.italy@iol.it> |
|---|---|
| Date | 2020-03-15 11:36 -0700 |
| Subject | RIBA in formato xml iso 20022 |
| Message-ID | <243ef28f-a72b-4890-924f-ffbed8ec5670@googlegroups.com> |
Cerco uno standard per questo formato, magari generato da VB 6.0 o VBA. Grazie.
[toc] | [next] | [standalone]
| From | "Sauro" <vicchi@crsscala.it> |
|---|---|
| Date | 2020-03-17 13:20 +0100 |
| Message-ID | <r4qf9s$d4r$1@gioia.aioe.org> |
| In reply to | #19729 |
"sal21" <gss.italy@iol.it> ha scritto nel messaggio > Cerco uno standard per questo formato, magari generato da VB 6.0 o VBA. > Grazie. Se dovesse servirti ho quello per fare i bonifici. Per quanto riguarda le RIBA (le presentazioni SBF e non i pagamenti) uso ancora i file ASC Ciao Sal Sauro
[toc] | [prev] | [next] | [standalone]
| From | RobertoA <amorosik@tiscalinet.it> |
|---|---|
| Date | 2020-03-17 13:57 +0100 |
| Message-ID | <r4qgkr$j5t$1@gioia.aioe.org> |
| In reply to | #19730 |
Il 17/03/2020 13:20, Sauro ha scritto: > "sal21" <gss.italy@iol.it> ha scritto nel messaggio > >> Cerco uno standard per questo formato, magari generato da VB 6.0 o VBA. >> Grazie. > > Se dovesse servirti ho quello per fare i bonifici. > > Per quanto riguarda le RIBA (le presentazioni SBF e non i pagamenti) > uso ancora i file ASC > > Ciao Sal > Sauro > > E' possibile dare un'occhiata al codice per generare le riba?
[toc] | [prev] | [next] | [standalone]
| From | "Sauro" <vicchi@crsscala.it> |
|---|---|
| Date | 2020-03-18 17:50 +0100 |
| Message-ID | <r4tjhf$5tu$1@gioia.aioe.org> |
| In reply to | #19731 |
[cut] Un paio di giorni per estrarre solo la parte cche interessa Ciao Sauro
[toc] | [prev] | [next] | [standalone]
| From | sal21 <gss.italy@iol.it> |
|---|---|
| Date | 2020-03-18 10:44 -0700 |
| Message-ID | <51244449-953e-414c-91d4-25a90053138f@googlegroups.com> |
| In reply to | #19739 |
Il giorno mercoledì 18 marzo 2020 17:50:59 UTC+1, Sauro ha scritto: > [cut] > > Un paio di giorni per estrarre solo > la parte cche interessa > > Ciao Sauro grazie aspetto. Sal
[toc] | [prev] | [next] | [standalone]
| From | "Sauro" <vicchi@crsscala.it> |
|---|---|
| Date | 2020-03-19 11:58 +0100 |
| Message-ID | <r4vj83$v1e$1@gioia.aioe.org> |
| In reply to | #19731 |
> E' possibile dare un'occhiata al codice per generare le riba? Ciao Roberto Il file ASC non è altro che un semplice file ASCII con delle righe a lunghezza fissa. Il nome, generato in automatico nel mio esempio, deve essere assolutamente univoco pertanto io ho inserito data e orari di creazione. Seguiranno 2 post. Uno con il codice Uno con un file ASC di esempio per due ricevute
[toc] | [prev] | [next] | [standalone]
| From | RobertoA <amorosik@tiscalinet.it> |
|---|---|
| Date | 2020-03-19 14:10 +0100 |
| Message-ID | <r4vq55$hf8$1@gioia.aioe.org> |
| In reply to | #19743 |
Il 19/03/2020 11:58, Sauro ha scritto: >> E' possibile dare un'occhiata al codice per generare le riba? > > Ciao Roberto > > Il file ASC non è altro che un semplice file ASCII con delle > righe a lunghezza fissa. > Il nome, generato in automatico nel mio esempio, deve essere > assolutamente univoco pertanto io ho inserito data e orari > di creazione. > Seguiranno 2 post. > Uno con il codice > Uno con un file ASC di esempio per due ricevute > > Molte grazie per l'esempio postato Abbi pazienza ma ho altre due domande su questo argomento - dove trovare le specifiche tecniche per creare questi file? - come verificare se il file prodotto e' corretto? Ciao e grazie
[toc] | [prev] | [next] | [standalone]
| From | "Sauro" <vicchi@crsscala.it> |
|---|---|
| Date | 2020-03-19 17:41 +0100 |
| Message-ID | <r507b0$19fj$1@gioia.aioe.org> |
| In reply to | #19748 |
> Molte grazie per l'esempio postato > Abbi pazienza ma ho altre due domande su questo argomento > - dove trovare le specifiche tecniche per creare questi file? > - come verificare se il file prodotto e' corretto? > Ciao e grazie Le specifiche non le ho mai trovate. Sono partito da un esempio come eventualmente dovresti fare tu. La verifica può essere fatta, che io sappia, solo inviando il file ASC alla banca. Però devo aggiungere che non vale la pena di perderci tempo in quanto il file ASC è già obsoleto anche se le banche, almeno in zona, l'accettano ancora. Lo standard attuale è un file xml. Trovando le specifiche in un giorno si fa il programma. Io mi sono fatto un'esperienza xml lavorando sulla fattura elettronica. C'è un'associazione bancaria che ha le specifiche e alla quale mi ero anche iscritto. Ti manda una mail ogni tanto e fanno dei webinar. E' gratuito ma non ricordo più come si chiama. Se mi viene in mente lo posto. Ciao Roberto Sauro
[toc] | [prev] | [next] | [standalone]
| From | "Sauro" <vicchi@crsscala.it> |
|---|---|
| Date | 2020-03-20 08:48 +0100 |
| Message-ID | <r51sfg$16mn$1@gioia.aioe.org> |
| In reply to | #19748 |
Ecco ho trovato :www.cbi-org.eu Bisogna iscriversi e perderci un pò di tempo per trovare quello che ti serve. Ciao Roberto Sauro
[toc] | [prev] | [next] | [standalone]
| From | "Sauro" <vicchi@crsscala.it> |
|---|---|
| Date | 2020-03-19 12:06 +0100 |
| Message-ID | <r4vjoa$175s$1@gioia.aioe.org> |
| In reply to | #19731 |
'Dati lettura ricevute da eseguire prima di Scrivi_ASC
Public QuanteRicevute As Integer
Public rDoc(1 To 1000) As String '80 CARATTERI ES: FATTURA 12345 DEL
01/01/2000
Public rImp(1 To 1000) As Double 'Importo ricevuta
Public rScad(1 To 1000) As Date 'Scadenza
Public rABI(1 To 1000) As String '5 caratteri
Public rCAB(1 To 1000) As String '5 caratteri
Public rBANCAAPP(1 To 1000) As String '50 CARATTERI
Public rConto(1 To 1000) As String 'Codice anagrafico del cliente
'Dati generali
Dim SIAmittente As String 'Codice di 5 caratteri
Dim NomeSupporto As String
Dim Totale As Double
'Dati banca
Dim ABIbanca As String '5 caratteri
Dim CABbanca As String '5 caratteri
Dim CCbanca As String '12 caratteri
'per il file
Dim IB As String
Dim EF As String
Dim TestoASC As String
Dim RigaASC As String
Dim T As Integer
'Dati ditta
Dim Titolare48 As String '48 caratteri
Dim TitolareVia As String '24 caratteri
Dim TitolareCitta As String '24 caratteri
Dim TitolareFisc As String '16 caratteri
'Dati cliente
Dim bFiscale As String 'Codice fiscale o paertita IVA
Dim bCLI_FORN As String '60 caratteri - descrizione cliente
Dim bVia As String '30 caratteri
Dim bCittaProv As String '25 caratteri Città + sigla provincia
Dim bCAP As String '5 caratteri
'Scrittura del file
Public Sub Scrivi_ASC()
SIAmittente = "4Y734" 'E' un codice attribuito da banca a ditta
NomeSupporto = Adesso 'AAmmggOOmmss
'Leggere dati banca:
'Dim ABIbanca As String '5 caratteri
'Dim CABbanca As String '5 caratteri
'Dim CCbanca As String '12 caratteri
'Leggere i dati della ditta
'Dim Titolare48 As String '48 caratteri
'Dim TitolareVia As String '24 caratteri
'Dim TitolareCitta As String '24 caratteri
'Dim TitolareFisc As String
IB = " IB" & SIAmittente & ABIbanca & ggmmaa(DataOggi) & LL(NomeSupporto,
20) & "RIBA " & Space(59) & Space(9) & "E" & Space(5)
'EF verrà completato a fine ciclo
EF = " EF" & SIAmittente & ABIbanca & ggmmaa(DataOggi) & LL(NomeSupporto,
20) & "RIBA "
TestoASC = IB & vbNewLine
For T = 1 To QuanteRicevute
' Leggere dati anagrafici del cliente usando rConto(T)
'Dim bFiscale As String 'Codice fiscale o paertita IVA
'Dim bCLI_FORN As String '60 caratteri - descrizione cliente
'Dim bVia As String '30 caratteri
'Dim bCittaProv As String '25 caratteri Città + sigla provincia
'Dim bCAP As String '5 caratteri
RigaASC = " 14" & STRZero(T, 7) & Space(12) & ggmmaa(rScad(T)) & "30000"
_
& STRZero(rImp(T) * 100, 13) & "-" & LL(ABIbanca, 5) &
LL(CABbanca, 5) & LL(CCbanca, 12) _
& rABI(T) & rCAB(T) & Space(12) & SIAmittente & "4" &
LL(rConto(T), 16) & " " & Space(5) & "E"
TestoASC = TestoASC & RigaASC & vbNewLine
'
RigaASC = " 20" & STRZero(T, 7) & Titolare48 & TitolareVia &
TitolareCitta & Space(14)
TestoASC = TestoASC & RigaASC & vbNewLine
'
RigaASC = " 30" & STRZero(T, 7) & LL(bCLI_FORN, 60) & LL(bFiscale, 16) &
Space(24)
TestoASC = TestoASC & RigaASC & vbNewLine
'
RigaASC = " 40" & STRZero(T, 7) & bVia & LL(bCAP, 5) & LL(bCittaProv,
25) & LL(rBANCAAPP(T), 50)
TestoASC = TestoASC & RigaASC & vbNewLine
'
RigaASC = " 50" & STRZero(T, 7) & LL(rDoc(T), 80) & Space(10) &
LL(TitolareFisc, 16) & Space(14)
TestoASC = TestoASC & RigaASC & vbNewLine
'
RigaASC = " 51" & STRZero(T, 7) & STRZero(T, 10) & Left(Titolare48, 20)
& Space(80)
TestoASC = TestoASC & RigaASC & vbNewLine
'
RigaASC = " 70" & STRZero(T, 7) & Space(91) & "0" & Space(18)
TestoASC = TestoASC & RigaASC & vbNewLine
'
Totale = Totale + rImp(T)
Next T
'EF = " EF" & SIAmittente & ABIbanca & ggmmaa(DataOggi) & NomeSupporto &
"CampoD"
EF = EF & STRZero(T, 7) & STRZero(Totale * 100, 15) & "000000000000000" &
STRZero((T * 7) + 2, 7) & Space(24) & "E" & Space(5)
TestoASC = TestoASC & EF
ScriviFileASCII "C:\ASC" & NomeSupporto & ".ASC", TestoASC
Call MsgBox("Creato file:" _
& vbCrLf & "C:\ASC" & NomeSupporto & ".ASC" _
, vbInformation, App.Title)
End Sub
Public Function ggmmaa(UnaData As Date) As String
Dim Rit As String
Rit = Format(UnaData, "dd/mm/yy")
ggmmaa = Replace(Rit, "/", "")
End Function
Public Function Adesso() As String
Dim AA As String
AA = STRZero(Year(Date), 4)
Adesso = Right(AA, 2) & STRZero(Month(Date), 2) & STRZero(Day(Date), 2) &
STRZero(Hour(Time()), 2) & STRZero(Minute(Time()), 2) &
STRZero(Second(Time()), 2)
End Function
Public Sub ScriviFileASCII(PathDestinazione As String, TestoFile As String)
Dim nFileDestinazione As Integer
If Dir(PathDestinazione) <> "" Then Kill PathDestinazione
nFileDestinazione = FreeFile
' APRO FILE DI DESTINAZIONE
Open PathDestinazione For Binary Access Write As #nFileDestinazione '
Apre il file.
Put #nFileDestinazione, , TestoFile
Close #nFileDestinazione
End Sub
Public Function STRZero(ByVal Numero, Optional Lung As Long = 15, Optional
Dec As Long = 0) As String
Dim Ritorno As String
Dim Inizio As String
Select Case Dec
Case 0
Ritorno = Format(Numero, "#################")
Case 1
Ritorno = Format(Numero, "################.#")
Case 2
Ritorno = Format(Numero, "###############.##")
Case 3
Ritorno = Format(Numero, "##############.###")
End Select
Inizio = String(Lung - Len(Ritorno), "0")
STRZero = Inizio & Ritorno
End Function
Public Function LL(Corto As String, Lunghezza As Variant) As String
If Len(Corto) >= Lunghezza Then
LL = Corto
Else
LL = Corto & String(Lunghezza - Len(Corto), " ")
End If
End Function
Public Function LLrev(Corto As String, Lunghezza As Variant) As String
If Len(Corto) < Lunghezza Then
LLrev = String(Lunghezza - Len(Corto), " ") & Corto
Else
LLrev = Corto
End If
End Function
[toc] | [prev] | [next] | [standalone]
| From | "Sauro" <vicchi@crsscala.it> |
|---|---|
| Date | 2020-03-19 12:07 +0100 |
| Message-ID | <r4vjpn$189t$1@gioia.aioe.org> |
| In reply to | #19731 |
IB36R1902008190320200319083033 RIBA E 140000001 301119300000000000069339-02008237050000035218440200836800 36R194C061 E 200000001EUROTECNO SRL - CARICO/SCARICO VIA LUIGI GALVANI 45/47 FAENZA 300000001LAMPROJECT SRL 02103160392 400000001VIA MORANDI 65/67/69 40026TOSCANELLA DI DOZZA (BO) UNICREDIT BANCA SPA 500000001Ft. 264 del 31/08/2019 02036270391 5100000010000000001EUROTECNO SRL - CARI 700000001 0 140000002 311219300000000004249095-02008237050000035218440538712801 36R194C082 E 200000002EUROTECNO SRL - CARICO/SCARICO VIA LUIGI GALVANI 45/47 FAENZA 300000002Teko Telecom S.r.l. a Socio Unico 03272231204 400000002VIA MEUCCI 24/A 40024CASTEL S.PIETRO T. BO BANCA POP EMILIA ROM - AG.1 REG EMIL 500000002Ft. 267 del 31/08/2019 02036270391 5100000020000000002EUROTECNO SRL - CARI 700000002 0 EF36R1902008190320200319083033 RIBA 00000020000000043184340000000000000000000016 E
[toc] | [prev] | [next] | [standalone]
| From | "Sauro" <vicchi@crsscala.it> |
|---|---|
| Date | 2020-03-19 13:06 +0100 |
| Message-ID | <r4vn7t$13rv$1@gioia.aioe.org> |
| In reply to | #19745 |
Purtroppo le righe si spezzano
[toc] | [prev] | [next] | [standalone]
| From | sal21 <gss.italy@iol.it> |
|---|---|
| Date | 2020-03-17 08:24 -0700 |
| Message-ID | <ef804d13-e5f7-4983-af07-e49a85ece4ff@googlegroups.com> |
| In reply to | #19730 |
Il giorno martedì 17 marzo 2020 13:20:16 UTC+1, Sauro ha scritto: > "sal21" <gss.italy@iol.it> ha scritto nel messaggio > > > Cerco uno standard per questo formato, magari generato da VB 6.0 o VBA. > > Grazie. > > Se dovesse servirti ho quello per fare i bonifici. > > Per quanto riguarda le RIBA (le presentazioni SBF e non i pagamenti) > uso ancora i file ASC > > Ciao Sal > Sauro Grazie Sauro! Sei stato uno dei pochi che mi ha risposto nel modo corretto, ma anche professionale. Se qualcuno chiede qualcosa qui vuol dire che ha bisogno di aiuto e ha capito pure il senso del gruppo. Si, quello dei bonifici mi farebbe molto piacere perchè il mio cliente me lo aveva già chiesto in precedenza ma ad oggi non potevo ancora aiutarlo. Mandami il codice nella mia email personale. A buon rendere, se hai bisogno chiedimi pure. Sal
[toc] | [prev] | [next] | [standalone]
| From | Greg <greg@alicie.com> |
|---|---|
| Date | 2020-03-17 20:44 +0100 |
| Message-ID | <r4r9ap$vp0$1@solani.org> |
| In reply to | #19732 |
Il 17/03/20 16:24:42 sal21 ha scritto: > Mandami il codice nella mia email personale. > A buon rendere, se hai bisogno chiedimi pure. Veramente il senso del ng sarebbe l'opposto -- Greg
[toc] | [prev] | [next] | [standalone]
| From | sal21 <gss.italy@iol.it> |
|---|---|
| Date | 2020-03-17 14:38 -0700 |
| Message-ID | <0f8a4b97-ba2f-4ccf-87bd-44f7bd76fdad@googlegroups.com> |
| In reply to | #19729 |
Il giorno domenica 15 marzo 2020 19:36:30 UTC+1, sal21 ha scritto: > Cerco uno standard per questo formato, magari generato da VB 6.0 o VBA. > Grazie. Ok forse sono stato troppo precipitoso... quindi chiedo a Sauro di postare l codice sul gruppo al fine di renderlo pubblico. Grazie
[toc] | [prev] | [next] | [standalone]
| From | "Sauro" <vicchi@crsscala.it> |
|---|---|
| Date | 2020-03-19 11:53 +0100 |
| Message-ID | <r4vivf$q9f$1@gioia.aioe.org> |
| In reply to | #19735 |
Qualche giorno per preparare il tutto
[toc] | [prev] | [next] | [standalone]
| From | "Sauro" <vicchi@crsscala.it> |
|---|---|
| Date | 2020-03-19 18:25 +0100 |
| Message-ID | <r509te$1v6u$1@gioia.aioe.org> |
| In reply to | #19735 |
> forse sono stato troppo precipitoso... > quindi chiedo a Sauro di postare l codice sul gruppo al fine di renderlo > pubblico. > Grazie In realtà io non ho usato le procedure predisposte per gestire i file XML in quanto non era possibile con VB6 ma solo con .NET che non conosco. Ho usato un metodo grossolano che però funziona. Tieni presente che i programmi che leggono i fiel XML vanno in errore se si usano particolari caratteri (problematica dei file UTF su cui non entro). Io sostituisco questi caratteri con altri (vedi funzione UTF nel codice). Seguiranno 2 post. Uno con il codice Uno con 3 file di base che servono alla procedura. Ciao Sal Sauro
[toc] | [prev] | [next] | [standalone]
| From | sal21 <gss.italy@iol.it> |
|---|---|
| Date | 2020-03-19 13:32 -0700 |
| Message-ID | <a0c5a4fc-4e59-4e1c-a3b7-297119aa1892@googlegroups.com> |
| In reply to | #19750 |
Il giorno giovedì 19 marzo 2020 18:25:06 UTC+1, Sauro ha scritto: > > forse sono stato troppo precipitoso... > > quindi chiedo a Sauro di postare l codice sul gruppo al fine di renderlo > > pubblico. > > Grazie > > In realtà io non ho usato le procedure predisposte per gestire i file XML > in quanto non era possibile con VB6 ma solo con .NET che non conosco. > Ho usato un metodo grossolano che però funziona. > Tieni presente che i programmi che leggono i fiel XML vanno in errore > se si usano particolari caratteri (problematica dei file UTF su cui non > entro). > Io sostituisco questi caratteri con altri (vedi funzione UTF nel codice). > > Seguiranno 2 post. > Uno con il codice > Uno con 3 file di base che servono alla procedura. > > Ciao Sal > Sauro SPETTACOLARE! Gazie.
[toc] | [prev] | [next] | [standalone]
| From | "Sauro" <vicchi@crsscala.it> |
|---|---|
| Date | 2020-03-19 18:25 +0100 |
| Message-ID | <r509v1$1v9h$1@gioia.aioe.org> |
| In reply to | #19735 |
Public xINIZIO As String 'Legge il file BONIF_XML_TESTATA
Public xXML As String 'Legge il file BONIF_XML_CORPO
Public xFINE As String 'Legge il file BONIF_XML_FINE
Public ContaBonifici As Integer
Public Dx(1 To 500, 1 To 50) As String
Public DxCod(1 To 500) As String
Public DxOrd(1 To 500) As Double
Public DollaroTOTALE As Double
Public R As Long
Public QuantiRec As Long
Dim T1 As String
Dim TTUTTO As String
Dim Dollari As String
Dim Adesso1 As String
Dim Adesso2 As String
Dim Quanti As String
Dim ContaDisp As Integer
Dim Distinta As String
Public Sub Fai_File_XML_Bonifici()
Dim R As Integer
Dim XML_testoFile As String
Dim XML_nomeFile As String
Adesso1 = Adesso
Adesso2 = AAAA_MM_GG(Date)
TotElFin = 0
STRINGA1 = ""
xINIZIO = TestoNetto(LeggiFileASCII(App.Path & "\BONIF_XML_TESTATA.TXT"))
xXML = TestoNetto(LeggiFileASCII(App.Path & "\BONIF_XML_CORPO.TXT"))
xFINE = TestoNetto(LeggiFileASCII(App.Path & "\BONIF_XML_FINE.TXT"))
TTUTTO = ""
If Esempio_Leggi_Bonifici_XML Then
ContaDisp = 0
For R = 1 To QuantiRec
T1 = xXML
ContaDisp = ContaDisp + 1
For X = 10 To 50 'Dati di dettaglio
If X = 30 Then
X = X
End If
If Dx(R, X) = "//" Then GoTo FineR
Dollari = "$" & Trim(Str(X)) & "$"
T1 = Replace(T1, Dollari, Trim(Dx(R, X)))
Next X
FineR:
T1 = Replace(T1, "$NUMERODISP$", Trim(Str(ContaDisp)))
TTUTTO = TTUTTO & T1
Next R
Else
'Errore
End If
TTUTTO = xINIZIO & vbCrLf & TTUTTO & xFINE
TTUTTO = Replace(TTUTTO, "$ADESSO1$", Adesso1)
TTUTTO = Replace(TTUTTO, "$ADESSO2$", Adesso2)
TTUTTO = Replace(TTUTTO, "$QUANTI$", QuantiRec)
For X = 3 To 9 'Dati generali
If Dx(QuantiRec, X) = "//" Then GoTo FineFine
Dollari = "$" & Trim(Str(X)) & "$"
TTUTTO = Replace(TTUTTO, Dollari, Dx(QuantiRec, X))
Next X
FineFine:
TTUTTO = Replace(TTUTTO, "$TOT$", Str_Importo(DollaroTOTALE))
XML_nomeFile = App.Path & "\XML_BACK.XML"
ScriviFileASCII XML_nomeFile, TTUTTO
'Registra i bonifici come XML fatti
XML_testoFile = Compatta(TTUTTO)
XML_nomeFile = App.Path & "\BON_" & Adesso & ".XML"
ScriviFileASCII XML_nomeFile, XML_testoFile
Call MsgBox("Salvato file" _
& vbCrLf & XML_nomeFile _
, vbInformation, App.Title)
End Sub
Private Function Compatta(Testo1 As String) As String
Dim Testo2 As String
Dim Lines As Long
Dim L As Long
Testo1 = TestoNetto(Testo1)
Lines = MemoLines(Testo1)
For L = 1 To Lines
Testo2 = Testo2 & Trim(MemoLine(Testo1, L))
Next L
Compatta = Testo2
End Function
Public Function Esempio_Leggi_Bonifici_XML() As Boolean
'Funzione che legge la tabella dei bonifici
'il campo x_ord contiene l'importo
'i campi X_3 / X_9 CONTENGONO DATI GENERALI
'i campi X_10 / X_37 CONTENGONO DATI DETTAGLIO DEL SINGOLO BONIFICO
Dim SelectSQL As String
Dim X As Integer
Dim RS As Recordset
DollaroTOTALE = 0
SelectSQL = "SELECT * FROM DETT1_XML WHERE X_48='//' AND X_49 = 'BONIFICO'
ORDER BY X_50"
Set RS = PublicDB.OpenRecordset(SelectSQL)
If RS.RecordCount > 0 Then
RS.MoveFirst
RS.MoveLast
QuantiRec = RS.RecordCount
RS.MoveFirst
For R = 1 To QuantiRec
DxCod(R) = RS.fields(0) ' 1 X_COD Testo 50
DxOrd(R) = RS.fields(1) ' 2 X_ORD Numero 8
DollaroTOTALE = DollaroTOTALE + DxOrd(R)
Dx(R, 3) = RS.fields(2) ' 3 X_3 Testo 50
Dx(R, 4) = RS.fields(3) ' 4 X_4 Testo 50
Dx(R, 5) = RS.fields(4) ' 5 X_5 Testo 50
Dx(R, 6) = RS.fields(5) ' 6 X_6 Testo 50
Dx(R, 7) = RS.fields(6) ' 7 X_7 Testo 50
Dx(R, 8) = RS.fields(7) ' 8 X_8 Testo 50
Dx(R, 9) = RS.fields(8) ' 9 X_9 Testo 50
Dx(R, 10) = RS.fields(9) ' 10 X_10 Testo 50
Dx(R, 11) = RS.fields(10) ' 11 X_11 Testo 50
Dx(R, 12) = RS.fields(11) ' 12 X_12 Testo 50
Dx(R, 13) = RS.fields(12) ' 13 X_13 Testo 50
Dx(R, 14) = RS.fields(13) ' 14 X_14 Testo 50
Dx(R, 15) = RS.fields(14) ' 15 X_15 Testo 50
Dx(R, 16) = RS.fields(15) ' 16 X_16 Testo 50
Dx(R, 17) = RS.fields(16) ' 17 X_17 Testo 50
Dx(R, 18) = RS.fields(17) ' 18 X_18 Testo 50
Dx(R, 19) = RS.fields(18) ' 19 X_19 Testo 50
Dx(R, 20) = RS.fields(19) ' 20 X_20 Testo 50
Dx(R, 21) = RS.fields(20) ' 21 X_21 Testo 50
Dx(R, 22) = RS.fields(21) ' 22 X_22 Testo 50
Dx(R, 23) = RS.fields(22) ' 23 X_23 Testo 50
Dx(R, 24) = RS.fields(23) ' 24 X_24 Testo 50
Dx(R, 25) = RS.fields(24) ' 25 X_25 Testo 50
Dx(R, 26) = RS.fields(25) ' 26 X_26 Testo 50
Dx(R, 27) = RS.fields(26) ' 27 X_27 Testo 50
Dx(R, 28) = RS.fields(27) ' 28 X_28 Testo 50
Dx(R, 29) = RS.fields(28) ' 29 X_29 Testo 50
Dx(R, 30) = RS.fields(29) ' 30 X_30 Testo 50
Dx(R, 31) = RS.fields(30) ' 31 X_31 Testo 50
Dx(R, 32) = RS.fields(31) ' 32 X_32 Testo 50
Dx(R, 33) = RS.fields(32) ' 33 X_33 Testo 50
Dx(R, 34) = RS.fields(33) ' 34 X_34 Testo 50
Dx(R, 35) = RS.fields(34) ' 35 X_35 Testo 50
Dx(R, 36) = RS.fields(35) ' 36 X_36 Testo 50
Dx(R, 37) = RS.fields(36) ' 37 X_37 Testo 50
Dx(R, 38) = RS.fields(37) ' 38 X_38 Testo 50
Dx(R, 39) = RS.fields(38) ' 39 X_39 Testo 50
Dx(R, 40) = RS.fields(39) ' 40 X_40 Testo 50
Dx(R, 41) = RS.fields(40) ' 41 X_41 Testo 50
Dx(R, 42) = RS.fields(41) ' 42 X_42 Testo 50
Dx(R, 43) = RS.fields(42) ' 43 X_43 Testo 50
Dx(R, 44) = RS.fields(43) ' 44 X_44 Testo 50
Dx(R, 45) = RS.fields(44) ' 45 X_45 Testo 50
Dx(R, 46) = RS.fields(45) ' 46 X_46 Testo 50
Dx(R, 47) = RS.fields(46) ' 46 X_47 Testo 50
Dx(R, 48) = RS.fields(47) ' 47 X_48 Testo 50
Dx(R, 49) = RS.fields(48) ' 48 X_49 Testo 50
Dx(R, 50) = RS.fields(49) ' 49 X_50 Testo 50
Dx(R, 50) = LL(Dx(R, 50), 14)
For X = 3 To 45
Dx(R, X) = UTF(Dx(R, X))
Next X
RS.MoveNext
Next R
Else
Esempio_Leggi_Bonifici_XML = False
Exit Function
End If
Esempio_Leggi_Bonifici_XML = True
End Function
Public Function UTF(ByVal T As String) As String
'Attenzione il simbolo ° da errore
T = Replace(T, "&", "e") ' Asc(38)
T = Replace(T, "<", " ") ' Asc(60)
T = Replace(T, ">", " ") ' Asc(62)
T = Replace(T, Chr$(34), " ") ' Asc(34)
T = Replace(T, "'", " ") ' Asc(39)
T = Replace(T, """, " ") ' Asc(147)
T = Replace(T, """, " ") ' Asc(148)
T = Replace(T, "à", "a") ' Asc(224)
T = Replace(T, "á", "a") ' Asc(225)
T = Replace(T, "é", "e") ' Asc(233)
T = Replace(T, "è", "e") ' Asc(232)
T = Replace(T, "ì", "i") ' Asc(236)
T = Replace(T, "í", "i") ' Asc(237)
T = Replace(T, "ò", "o") ' Asc(242)
T = Replace(T, "ó", "o") ' Asc(243)
T = Replace(T, "ù", "u") ' Asc(249)
T = Replace(T, "ú", "u") ' Asc(250)
T = Replace(T, "°", " ") ' Asc(176)
T = Replace(T, "£", "L") ' Asc(163)
T = Replace(T, "?", "EUR") ' Asc(128)
T = Replace(T, "ç", "c") ' Asc(231)
T = Replace(T, "§", " ") ' Asc(167)
T = Replace(T, "Ø", "D.") ' Asc(216)
T = Replace(T, "z", "z") ' Asc(158)
T = Replace(T, "ö", "o") ' Asc(246)
T = Replace(T, "ß", "B") ' Asc(223)
T = Replace(T, "ä", "a") ' Asc(228)
T = Replace(T, "â", "a") ' Asc(226)
T = Replace(T, "Ñ", "N") ' Asc(209)
T = Replace(T, "Ö", "O") ' Asc(214)
T = Replace(T, "É", "E") ' Asc(201)
T = Replace(T, "Ü", "U") ' Asc(220)
T = Replace(T, "Ä", "A") ' Asc(196)
T = Replace(T, "Â", "A") ' Asc(194)
UTF = T
End Function
Function LeggiFileASCII(PathOrigine As String) As String
Dim sTextLine As String, lRestoFile As Long
Dim nFileOrigine As Integer
Dim lDimensioneFile As Long, lCounter As Long
Dim Testo As String
On Error GoTo LeggiFileASCII_Error
nFileOrigine = FreeFile
Open PathOrigine For Binary As #nFileOrigine ' Apre il file.
' imposto variabili base
lCounter = 1
lDimensioneFile = LOF(nFileOrigine)
sTextLine = String(4000, ".") '
' restituisce la dimensione restante dopo tutti i
' blocchi di byte
lRestoFile = lDimensioneFile - Int(lDimensioneFile / 4000) * 4000
Do While Not EOF(nFileOrigine) ' Ripete fino alla fine del file.
sTextLine = String(4000, ".") '
If lCounter < Int(lDimensioneFile / 4000) * 4000 Then
' leggo e copio blocco dati
' BLOCCO INTERO
Get #nFileOrigine, lCounter, sTextLine
lCounter = lCounter + 4000
Testo = Testo & sTextLine
Else
' reimposto txtline sui bytes restanti
' BLOCCO ULTIMO PARZIALE
sTextLine = String(lRestoFile, ".")
Get #nFileOrigine, lCounter, sTextLine
Testo = Testo & sTextLine
Exit Do
End If
Loop
If InStr(Testo, Chr(26)) > 0 Then 'Aggiunto per files creati con clipper
Testo = Left(Testo, InStr(Testo, Chr(26)) - 1)
End If
Close #nFileOrigine ' Chiude il file.
LeggiFileASCII = Testo
On Error GoTo 0
Exit Function
LeggiFileASCII_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & _
") in procedure LeggiFileASCII of Modulo Proc_Memo"
End Function
Public Sub ScriviFileASCII(PathDestinazione As String, TestoFile As String)
If Dir(PathDestinazione) <> "" Then Kill PathDestinazione
Dim nFileDestinazione As Integer
nFileDestinazione = FreeFile
' APRO FILE DI DESTINAZIONE
Open PathDestinazione For Binary Access Write As #nFileDestinazione '
Apre il file.
Put #nFileDestinazione, , TestoFile
Close #nFileDestinazione
End Sub
Public Function TestoNetto(ByVal TestoMemo As String) As String
Ricicla:
If Right(TestoMemo, 2) = vbCrLf Then
TestoMemo = Left(TestoMemo, Len(TestoMemo) - 2)
GoTo Ricicla
End If
TestoNetto = TestoMemo
End Function
Public Function MemoLines(ilTesto As String) As Single
' Ritorna il numero di righe in una stringa
Dim VarVariant As Variant
VarVariant = Split(ilTesto, vbCrLf)
MemoLines = (UBound(VarVariant) - LBound(VarVariant)) + 1
End Function
Public Function MemoLine(ilTesto As String, QualeRiga As Variant) As String
' Ritorna la stringa corrispondente alla riga voluta
If Len(ilTesto) < 1 Then
MemoLine = ""
Exit Function
End If
Dim VarVariant As Variant
VarVariant = Split(ilTesto, vbCrLf)
MemoLine = VarVariant(QualeRiga - 1)
End Function
Public Function Str_Importo(Impor As Double) As String
Dim Rit As String
If DoubleZero(Impor) Then
Str_Importo = "0"
Exit Function
End If
Rit = Trim(Vir(Impor, 15, 2))
If Right(Rit, 3) = ",00" Then
Rit = Left(Rit, Len(Rit) - 3)
Else
If Right(Rit, 1) = "0" Then
Rit = Left(Rit, Len(Rit) - 1)
End If
End If
Str_Importo = Replace(Rit, ",", ".")
End Function
Public Function AAAA_MM_GG(UnaData As Date) As String
Dim Rit As String
Rit = Format(UnaData, "yyyy/mm/dd")
AAAA_MM_GG = Replace(Rit, "/", "-")
End Function
Public Function Adesso() As String
Dim AA As String
AA = STRZero(Year(Date), 4)
Adesso = Right(AA, 2) & STRZero(Month(Date), 2) & STRZero(Day(Date), _
2) & STRZero(Hour(Time()), 2) & STRZero(Minute(Time()), _
2) & STRZero(Second(Time()), 2)
End Function
[toc] | [prev] | [next] | [standalone]
| From | "Sauro" <vicchi@crsscala.it> |
|---|---|
| Date | 2020-03-19 18:26 +0100 |
| Message-ID | <r50a0m$1vll$1@gioia.aioe.org> |
| In reply to | #19735 |
File: BONIF_XML_TESTATA.TXT
<?xml version="1.0" encoding="UTF-8" ?>
<CBIBdyPaymentRequest
xsi:schemaLocation="urn:CBI:xsd:CBIBdyPaymentRequest.00.04.00
CBIBdyPaymentRequest.00.04.00.xsd"
xmlns="urn:CBI:xsd:CBIBdyPaymentRequest.00.04.00"
xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
xmlns:DISTINTA="urn:CBI:xsd:CBIPaymentRequest.00.04.00"
xmlns:DISPOSIZIONE="urn:CBI:xsd:CBIPaymentRequest.00.04.00"
xmlns:BODY="urn:CBI:xsd:CBIBdyPaymentRequest.00.04.00"
xmlns:SGNT="urn:CBI:xsd:CBISgnInf.001.04">
<BODY:CBIEnvelPaymentRequest>
<BODY:CBIPaymentRequest>
<DISTINTA:GrpHdr>
<DISTINTA:MsgId>$ADESSO1$</DISTINTA:MsgId>
<DISTINTA:CreDtTm>$ADESSO2$T00:00:00</DISTINTA:CreDtTm>
<DISTINTA:NbOfTxs>$QUANTI$</DISTINTA:NbOfTxs>
<DISTINTA:CtrlSum>$TOT$</DISTINTA:CtrlSum>
<DISTINTA:InitgPty>
<DISTINTA:Nm>EUROTECNO SRL</DISTINTA:Nm>
<DISTINTA:Id>
<DISTINTA:OrgId>
<DISTINTA:Othr>
<DISTINTA:Id>1617457S</DISTINTA:Id>
<DISTINTA:Issr>CBI</DISTINTA:Issr>
</DISTINTA:Othr>
<DISTINTA:Othr>
<DISTINTA:Id>02036270391</DISTINTA:Id>
<DISTINTA:Issr>ADE</DISTINTA:Issr>
</DISTINTA:Othr>
</DISTINTA:OrgId>
</DISTINTA:Id>
</DISTINTA:InitgPty>
<DISTINTA:FwdgAgt>
<DISTINTA:FinInstnId>
<DISTINTA:ClrSysMmbId>
<DISTINTA:MmbId>06120</DISTINTA:MmbId>
</DISTINTA:ClrSysMmbId>
</DISTINTA:FinInstnId>
</DISTINTA:FwdgAgt>
</DISTINTA:GrpHdr>
<DISTINTA:PmtInf>
<DISTINTA:PmtInfId>$ADESSO1$</DISTINTA:PmtInfId>
<DISTINTA:PmtMtd>TRA</DISTINTA:PmtMtd>
<DISTINTA:PmtTpInf>
<DISTINTA:SvcLvl>
<DISTINTA:Cd>SEPA</DISTINTA:Cd>
</DISTINTA:SvcLvl>
</DISTINTA:PmtTpInf>
<DISTINTA:ReqdExctnDt>$5$</DISTINTA:ReqdExctnDt>
<DISTINTA:Dbtr>
<DISTINTA:Nm>EUROTECNO SRL</DISTINTA:Nm>
<DISTINTA:Id>
<DISTINTA:OrgId>
<DISTINTA:Othr>
<DISTINTA:Id>02036270391</DISTINTA:Id>
<DISTINTA:Issr>ADE</DISTINTA:Issr>
</DISTINTA:Othr>
</DISTINTA:OrgId>
</DISTINTA:Id>
</DISTINTA:Dbtr>
<DISTINTA:DbtrAcct>
<DISTINTA:Id>
<DISTINTA:IBAN>$3$</DISTINTA:IBAN>
</DISTINTA:Id>
</DISTINTA:DbtrAcct>
<DISTINTA:DbtrAgt>
<DISTINTA:FinInstnId>
<DISTINTA:ClrSysMmbId>
<DISTINTA:MmbId>$4$</DISTINTA:MmbId>
</DISTINTA:ClrSysMmbId>
</DISTINTA:FinInstnId>
</DISTINTA:DbtrAgt>
<DISTINTA:ChrgBr>SLEV</DISTINTA:ChrgBr>
File: BONIF_XML_CORPO.TXT
<DISPOSIZIONE:CdtTrfTxInf>
<DISPOSIZIONE:PmtId>
<DISPOSIZIONE:InstrId>$NUMERODISP$</DISPOSIZIONE:InstrId>
<DISPOSIZIONE:EndToEndId>$NUMERODISP$</DISPOSIZIONE:EndToEndId>
</DISPOSIZIONE:PmtId>
<DISPOSIZIONE:PmtTpInf>
<DISPOSIZIONE:CtgyPurp>
<DISPOSIZIONE:Cd>$22$</DISPOSIZIONE:Cd>
</DISPOSIZIONE:CtgyPurp>
</DISPOSIZIONE:PmtTpInf>
<DISPOSIZIONE:Amt>
<DISPOSIZIONE:InstdAmt Ccy="EUR">$24$</DISPOSIZIONE:InstdAmt>
</DISPOSIZIONE:Amt>
<DISPOSIZIONE:Cdtr>
<DISPOSIZIONE:Nm>$31$</DISPOSIZIONE:Nm>
<DISPOSIZIONE:PstlAdr>
<DISPOSIZIONE:AdrTp>ADDR</DISPOSIZIONE:AdrTp>
<DISPOSIZIONE:Ctry>IT</DISPOSIZIONE:Ctry>
</DISPOSIZIONE:PstlAdr>
<DISPOSIZIONE:Id>
<DISPOSIZIONE:OrgId>
<DISPOSIZIONE:Othr>
<DISPOSIZIONE:Id>$30$</DISPOSIZIONE:Id>
<DISPOSIZIONE:Issr>ADE</DISPOSIZIONE:Issr>
</DISPOSIZIONE:Othr>
</DISPOSIZIONE:OrgId>
</DISPOSIZIONE:Id>
</DISPOSIZIONE:Cdtr>
<DISPOSIZIONE:CdtrAcct>
<DISPOSIZIONE:Id>
<DISPOSIZIONE:IBAN>$25$</DISPOSIZIONE:IBAN>
</DISPOSIZIONE:Id>
</DISPOSIZIONE:CdtrAcct>
<DISPOSIZIONE:RmtInf>
<DISPOSIZIONE:Ustrd>$34$</DISPOSIZIONE:Ustrd>
</DISPOSIZIONE:RmtInf>
</DISPOSIZIONE:CdtTrfTxInf>
File: BONIF_XML_FINE.TXT
</DISTINTA:PmtInf>
</BODY:CBIPaymentRequest>
</BODY:CBIEnvelPaymentRequest>
</CBIBdyPaymentRequest>
[toc] | [prev] | [next] | [standalone]
Page 1 of 2 [1] 2 Next page →
Back to top | Article view | it.comp.lang.visual-basic
csiph-web