La funzione richiede in ingresso:
- Nome del file MDB da cui prelevare i dati
- Nome del file CSV da creare
- Nome della tabella da esportare
Option Explicit
ConvertMDB2CSV "c:\dati\database.mdb","c:\dati\esportazione.csv","NOMETABELLA"
Function ConvertMDB2CSV(MDBfilename, CSVfilename, tableName)
'On Error Resume Next
Dim objConn
Dim objRset
Dim rigaDati
Dim campoDB
Dim okCompleted
Dim numCampo
Dim separatoreRecord
Dim separatoreCampi
Const adOpenStatic = 3
Const adLockOptimistic = 3
separatoreCampi = ";"
separatoreRecord = vbCrLf
okCompleted=False
Rdy.SaveStringToFile CSVfilename,""
Set objConn = CreateObject("ADODB.Connection")
objConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & MDBfilename
If Not(Err) Then
Set objRset = CreateObject("ADODB.Recordset")
objRset.Open "SELECT * FROM [" & tableName & "]" , objConn, adOpenStatic, adLockOptimistic
' Esportazione nome campi
Set rigaDati=Rdy.BigString
numCampo=0
For Each campoDB In objRset.Fields
numCampo=numCampo+1
If numCampo>1 Then
rigaDati.add separatoreCampi
End If
rigaDati.add """" & replace("" & campoDB.name,"""","""""") & """"
Next
'Accoda il record al file CSV
Rdy.SaveStringToFile CSVfilename,rigaDati.value & separatoreRecord,True
' Esportazione dati
While Not(objRset.EOF)
Set rigaDati=Rdy.BigString
numCampo=0
For Each campoDB In objRset.Fields
numCampo=numCampo+1
If numCampo>1 Then
rigaDati.add separatoreCampi
End If
rigaDati.add """" & replace("" & campoDB.value,"""","""""") & """"
Next
'Accoda il record al file CSV
Rdy.SaveStringToFile CSVfilename,rigaDati.value & separatoreRecord,True
Set rigaDati=Nothing
objRset.MoveNext
Wend
objRset.Close
Set objRset=Nothing
okCompleted=True
End If
objConn.Close
Set objConn = Nothing
ConvertMDB2CSV=okCompleted
End Function