how do I dump an access 2000 database to .csv in vb6?

[CStaley]

I have no problem with dumping a database from access 97 to a csv file, however I can't find a definitive answer to do this with an access 2000 (or higher) database programmatically from within vb6. The code I was given produces an error 3197 (possibly a corrupt database, I don't know yet)

Can anyone here help?

 

[fredericofonseca]

show us the code you have at the moment working with 97

Regards

Frederico Fonseca
SysSoft Integrated Ltd

http://www.syssoft-int.com

FAQ219-2884
FAQ181-2886

 

[CStaley]

Here is the code that I use for access 97. I actually got the code (if I remember correctly) off this site and modified it to work with my app. This portion of the code opens the db, and exports it to a .csv format (with a .dat extension)

-----------------------------------------------------------
Public Property Get thedbfilelocation() As String
thedbfilelocation = dbfilepath
End Property

Public Property Let thedbfilelocation(ByVal vNewValue As String)
dbfilepath = vNewValue
End Property

Public Property Get thesql() As Variant
thesql = mysql
End Property

Public Property Let thesql(ByVal vNewValue As Variant)
mysql = vNewValue
End Property

Public Property Get thecounter() As Variant
thecounter = mycounter
End Property

Public Property Let thecounter(ByVal vNewValue As Variant)

mycounter = vNewValue
End Property

Public Property Get thefile() As Variant
thefile = exportfile
End Property

Public Property Let thefile(ByVal vNewValue As Variant)
exportfile = vNewValue
End Property

Public Function exportmydb(thedbfilelocation, thesql, thefile, thecounter)
'usage:
' x = exportmydb(App.Path & "\" & "database.mdb", "songs", "ExpFileName.dat", 12)
Dim err_1, Temp As String

On Error GoTo err_1
Dim filenum
Dim file2num
Dim i As Integer
Dim recproc As Single
Set thedb = OpenDatabase(thedbfilelocation)
Set myrecord = thedb.OpenRecordset(thesql)


filenum = FreeFile

'Stop
Open App.Path & "\" & thefile For Output As filenum ' to clear file
Print #filenum, "-----------------";
Print #filenum,
Print #filenum,
file2num = FreeFile
Close #filenum

Open App.Path & "\" & "datafile.dat" For Output As file2num
Open App.Path & "\" & thefile For Append As filenum
mycounter = myrecord.Fields.Count 'export all of the fields
Dim expfields(0 To 7) As Integer
'check that user entered right number of fields
If CInt(thecounter) > myrecord.Fields.Count Then
MsgBox ("Don't have that many fields in this DB")
Close filenum
Exit Function
Else

' fields names
For i = 0 To CInt(thecounter)
If i = (CInt(thecounter)) Then
Print #filenum, Chr$(34) & (myrecord.Fields(i).Name) & Chr$(34)
Else
Write #filenum, (myrecord.Fields(i).Name);
End If
Select Case myrecord.Fields(i).Name
Case "BookID"
expfields(0) = i
Case "SongTitle"
expfields(1) = i 'assigns the fieldnumbers to the array
Case "Artist"
expfields(2) = i 'for use below
Case "Duet"
expfields(3) = i
Case "Genre"
expfields(4) = i
Case "DiskID"
expfields(5) = i
Case "Path"
expfields(6) = i
Case Else
End Select

Next i
'Print #filenum, Chr$(10); '& Chr$(13)

While Not myrecord.EOF
recproc = recproc + 1
If recproc Mod 500 = 0 Then
'Stop
Form1.Label1.Caption = "Processing database.mdb: " & Format(recproc, "##,###")
Form1.Label1.Refresh
End If

For i = 0 To CInt(thecounter)
Temp = myrecord.Fields(i) 'used to remove double quotes

If InStr(1, Temp, Chr$(34)) > 0 Then Temp = ReplaceString$(myrecord.Fields(i), Chr$(34), "'")

If i = (CInt(thecounter)) Then
Print #filenum, Chr$(34) & (Temp) & Chr$(34) '& Chr$(10) ' Output text.without comma
Else 'print the comma
Write #filenum, (Temp); ' Output text.
If i < 6 Then
Temp = ReplaceString$(myrecord.Fields(expfields(i)), Chr$(34), "'")
Write #file2num, Temp; 'write to h.dat
End If
If i = 6 Then
Print #file2num, Chr$(34) & Temp & Chr(34) 'last field with no comma
End If
End If
Next i

myrecord.MoveNext
Wend

End If

Print #filenum, "***END***"
Form1.Label1.Caption = "Records Processed: " & Format(recproc, "##,###")
myrecord.Close
thedb.Close
Close #filenum ' Close file.
Close #file2num


Exit Function
err_1:
MsgBox (Err.Description)
Close filenum
Exit Function

End Function

Public Function gettables(thedbfilelocation, myform As Form, mylist As ListBox)
Dim err_2
On Error GoTo err_2
Dim i

'clear list
mylist.Visible = True
mylist.Clear


'specify DB
Set thedb = OpenDatabase(thedbfilelocation)


With thedb

For i = 0 To .TableDefs.Count - 1
If Left$(.TableDefs(i).Name, 4) <> "MSys" Then
mylist.AddItem .TableDefs(i).Name
End If
Next i

End With

Exit Function

err_2:
MsgBox Err.Description
Exit Function


End Function

Public Function getfields(thedbfilelocation, thesql)


Dim err_2
On Error GoTo err_3
Dim i


'specify DB
Set thedb = OpenDatabase(thedbfilelocation)
Set myrec = thedb.OpenRecordset(thesql)

getfields = myrec.Fields.Count

Exit Function

err_3:
MsgBox Err.Description
Exit Function


End Function

 

[HarleyQuinn]

Apart from an error using

For i = 0 To CInt(thecounter)

where using

For i = 0 To CInt(thecounter)-1

fixes the problem, the code works as expected for me.

Could be to do with the data in the table. See here

Hope this helps

HarleyQuinn
---------------------------------
Carter, hand me my thinking grenades!

You can hang outside in the sun all day tossing a ball around, or you can sit at your computer and do something that matters. - Eric Cartman

Get the most out of Tek-Tips, read FAQ222-2244: How to get the best answers before posting.

http

 

[HarleyQuinn]

Should have said, code works correctly for me in Access 2002

HarleyQuinn
---------------------------------
Carter, hand me my thinking grenades!

You can hang outside in the sun all day tossing a ball around, or you can sit at your computer and do something that matters. - Eric Cartman

Get the most out of Tek-Tips, read FAQ222-2244: How to get the best answers before posting.

http

 

[vb5prgrmr]

If using ADO 2.1 or I think 2.5 or DAO 2.5 or earlier but if I remember correctly is should be an unrecognized database format or...

If so, set reference to higher version.

Good Luck