by Mukund Srinivasan (1 Submission)
Category: OLE/COM/DCOM/Active-X
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Sat 9th August 2003
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
The Method writes out an ADO recordset to an MS-Access Table passing in relevant paramters
API Declarations
The .mdb file already exists in the path being passed in.
VBcoders
' ExportADOIntoAccess
'
' Description:
' This method accepts an ADO set and dumps it into an MSAccess table
' and returns a boolean
' Assumptions:
'
'
' Parameters:
' ByRef rst As ADODB.Recordset
' ByVal astrDBPath As String
'
' Returns:
' Boolean - True(Success) or False(Failed)
'
Public Function ExportADOIntoAccess(ByRef rst As ADODB.Recordset, _
ByVal astrDBPath As String, _
Optional ByVal astrTableName As String) As Boolean
Dim cnnDB As ADODB.Connection
Dim item As Variant
Dim i As Integer
Dim blnExists As Boolean 'Whether table in access exists
blnExists = False 'Set as default explicitly
' Initialize Connection object
Set cnnDB = New ADODB.Connection
Dim rstAccess As ADODB.Recordset
astrDBPath = ""
With cnnDB
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Open astrDBPath
Dim catDB As ADOX.Catalog
Dim tblNew As ADOX.Table
Dim tblList As ADOX.Table
Set catDB = New ADOX.Catalog
'Open the catalog.
catDB.ActiveConnection = cnnDB
'Check if table exists by pulling the list of available tables in access
For Each tblList In catDB.Tables
If tblList.Name = astrTableName Then
blnExists = True
Exit For
End If
Next tblList
If blnExists = True Then
'Delete old table and build new structure and pump the data in
catDB.Tables.Delete (astrTableName)
End If
'Create the table if not present already
'otherwise delete the old data and dump the new data into it
Set tblNew = New ADOX.Table
'Create a new Table object.
With tblNew
.Name = astrTableName 'Name of the table
' Create fields and append them to the Columns collection of the new Table object.
With .Columns
For Each item In rst.Fields
.Append item.Name, adVarWChar
Next item
End With
End With
' Add the new Table to the Tables collection of the database.
catDB.Tables.Append tblNew
Set catDB = Nothing
End With
'Now insert data into the newly created table in access
Set rstAccess = New ADODB.Recordset
With rstAccess
' Open the Recordset object.
.Open astrTableName, cnnDB, adOpenKeyset, adLockOptimistic
rst.MoveFirst
While Not rst.EOF
.AddNew
'Reset the counter each time
i = 0
For Each item In rst.Fields
If rst.Fields.item(i).Value = True And item.Type = adBoolean Then
rstAccess.Fields.item(i).Value = "Yes"
ElseIf rst.Fields.item(i).Value = False And item.Type = adBoolean Then
rstAccess.Fields.item(i).Value = "No"
ElseIf item.Type = adCurrency Or item.Type = adNumeric Then
rstAccess.Fields.item(i).Value = FormatCurrency(rst.Fields.item(i).Value, 2)
Else
rstAccess.Fields.item(i).Value = rst.Fields.item(i).Value
End If
i = i + 1
Next item
rst.MoveNext
Wend
' Save the changes you made to the current record in the Recordset object.
.UpdateBatch
' Close the Recordset object.
.Close
End With
ExportADOIntoAccess = True
'Clean up
Set rstAccess = Nothing
Set rst = Nothing
End Function
No comments have been posted about The Method writes out an ADO recordset to an MS-Access Table passing in relevant paramters. Why not be the first to post a comment about The Method writes out an ADO recordset to an MS-Access Table passing in relevant paramters.
