• Home
 · 
• OLE/COM/DCOM/Active-X
 · 
• The Method writes out an ADO recordset to an MS-Access Table passing in relevant paramters

The Method writes out an ADO recordset to an MS-Access Table passing in relevant paramters

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.



Rate The Method writes out an ADO recordset to an MS-Access Table passing in relevant paramters

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

'   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