🚀 go-pugleaf

"JtS" <JtS_NOSPAM@PLEASE.it> ha scritto nel messaggio
news:at1tpg$jhl$1@newsreader.mailgate.org...
>
> > In alternativa, � comodissimo creare un file .Csv, che pu� essere
> benissimo
> > aperto da Excel e che dal recordset puoi avere con un solo comando (che
> non
> > ricordo, ma dev'essere qualcosa tipo Recordset.GetString o simile).
>
> puoi crearti un file di testo con estensione xls dove utilizzi il vbtab
come
> separatore di campi
> funziona, � veloce e excel lo riconosce tranquillamente

Io uso GetString per esportare su CSV. Come vedi, la generazione del file �
una unica riga di codice [ADO_RCS.GetString(adClipString, -1, ";",
vbNewLine, "---")], per cui � velocissima.

Copio-Incollo qui sotto un po' di codice per creare un csv partendo da un
recordset ADO.

Ciao

Alberto



Private Sub BTN_Export_CSV_Click()
Dim ritorno2 As Long
Dim Percorso As String
Dim Percorso_Visualizzato As String
Dim FLD As ADODB.Field
Dim fil As Integer
Dim Prima_Riga As String
Dim Testo_Completo As String

On Error GoTo ErrHandler

CommonDialog1.CancelError = True

If Not CBool(ADO_RCS.State And adStateOpen) Then
    LBL_Status.Caption = "Prima di esportare i dati occorre visualizzarli."
    Exit Sub
End If

If ADO_RCS.BOF And ADO_RCS.EOF Then
    LBL_Status.Caption = "Nessun dato da Esportare"
    Exit Sub
End If

LBL_Status.Caption = "Procedura di Esportazione in corso..."
LBL_Status.Refresh

CommonDialog1.FileName = "c:\export.csv"

CommonDialog1.ShowSave
Percorso = CommonDialog1.FileName
ChDrive "c:"

If Percorso = vbNullString Then Percorso = "c:\export.csv"

If UCase(Right(Percorso, 4)) <> ".CSV" Then Percorso = Percorso & ".csv"

Percorso_Visualizzato = Percorso
If Len(Percorso_Visualizzato) > 60 Then
    Percorso_Visualizzato = Left(Percorso_Visualizzato, 25) & "\..\" &
Right(Percorso_Visualizzato, 25)
End If

LBL_Status.Caption = "Esportazione in Corso....."
LBL_Status.Refresh

fil = FreeFile()
Open Percorso For Output As #fil

'Inserisco le intestazioni di colonna
Prima_Riga = vbNullString
For Each FLD In ADO_RCS.Fields
    Prima_Riga = Prima_Riga & """" & FLD.Name & """;"
Next FLD
Prima_Riga = Left(Prima_Riga, Len(Prima_Riga) - 1)

'Creo la stringa complessiva del file
Testo_Completo = Prima_Riga & vbNewLine &
ADO_RCS.GetString(adClipString, -1, ";", vbNewLine, "---")

'Sostituisco le virgole decimali con i punti
Testo_Completo = Replace(Testo_Completo, ",", ".")

'Sostituisco il punto e virgola con la virgola
Testo_Completo = Replace(Testo_Completo, ";", ",")

'Metto la stringa completa nel file
Print #fil, Testo_Completo

Close

LBL_Status.Caption = "Esportazione Completata"

Ultima_Operazione = Now

Exit Sub
ErrHandler:
LBL_Status.Caption = "Esportazione Annullata"
Close

End Sub