ExportTableODBC

Function Esporta_Dati()
On Error Goto Esporta_Dati_Err
Screen.MousePointer = 11
'La connessione la faccio cosi':

Dim wrkJet As Workspace
Dim dbs As Database
Dim dbs2 as Database
Dim Tabella_Save(4) As String
Set wrkJet = CreateWorkspace("", "admin", "", dbUseJet)
Set dbs = wrkJet.OpenDatabase("Chiamata DSN", dbDriverPrompt, True, "DSN=Chiamata DSN" & ";DATABASE="Database ODBC" & ";UID=UserID" & ";PWD=Password")
'Questo e' il database di Access dove copio le tabelle:

Set dbs2 = wrkJet.OpenDatabase("Database Access")
Tabella_Save(1)="Tabella1"
Tabella_Save(2)="Tabella2"
Tabella_Save(3)="Tabella3"
For j = 1 To 3
DoEvents
'leggo i dati dalla tabella

Set rst(j) = dbs.OpenRecordset("select * from " & Tabella_Save(j), dbOpenSnapshot)

'Riempo i recordset

With rst(j)
.MoveLast
.MoveFirst
End With
Next j
For j = 1 To 3
DoEvents
'Se esiste gia' la tabella nel db access la elimino

For i = 0 To dbs2.TableDefs.Count - 1
If UCase$(dbs2.TableDefs(i).Name) = UCase$(Tabella_Save(j)) Then
Tabella = i
dbs2.Execute "DROP TABLE " & Tabella_Save(j) & ";"
End If
Next i

'Creo la tebella da copiare

dbs2.Execute "CREATE TABLE " & Tabella_Save(j) & "(" & rst(j).Fields(0).Name & " TEXT);"
N_Campi = rst(j).Fields.Count - 1

'Inserisco i campi

For i = 1 To N_Campi
dbs2.Execute "ALTER TABLE " & Tabella_Save(j) & Agg_DataBase & " ADD COLUMN " & rst(j).Fields(i).Name & " TEXT;"
Next i
'Prendo il recordset della tabella da copiare

Set rst2 = dbs2.OpenRecordset(Tabella_Save(j) , dbOpenDynaset)

'Copio le tabelle una a una

With rst(j)
Do While Not .EOF
With rst2
.AddNew
For i = 0 To .Fields.Count - 1
.Fields(i) = rst(j).Fields(i)
Next i
.Update
.Bookmark = .LastModified
End With
.MoveNext
Loop
End With
.Refresh
Next j
'Chiudo i database

dbs.Close
dbs2.Close
Screen.MousePointer = 0
Exit Function
Esporta_Dati_Err:
MsgBox Err.Number & " - " & Err.Description
Screen.MousePointer = 0
End Function

'******************************************************

'Fine procedura.

'******************************************************