VB 6.0 code to export data from access to excel

[maakali]

Hello there,

is there any code in vb 6.0 that i can use in my project to export data from access to excel

 

[Andrew Fergus]

Hi

I have tested the following and it works fine. On your VB6 form, create the following objects :

List box called 'List1' (set the 'Multilist' property to '1 - Simple')
'Copy' button called cmdCopy
'Exit' button called cmdExit
2 labels called 'lbldbFileName' and 'lblxlFileName'
'Select Database' button called 'cmdGetDB'
'Select Spreadsheet' button called 'cmdGetSS'
a dialog control called 'cdiagdb' (set the fileter property to Access Database | *.mdb)
a dialog control called 'cdiagxl' (set the filter property to Excel Spreadsheet | *.xls)
To enable common dialog controls, select menu option Project > Components > 'Microsoft Common Dialog Control'

Add the following Project References :
'Visual Basic for Applications'
'Visual Basic runtime objects and procedures'
'Microsoft DAO 3.6(?) Object Library'
'Microsoft Excel 11.0(?) Object Library'
You may have slightly different version numbers where I have used the question marks.

Add the following code :

Option Explicit

'*******************************************************************
'
'Written by Andrew Fergus (andrew93) in response to this question :
'http://www.mrexcel.com/board2/viewtopic.php?p=1125318
'on MrExcel.com
'
'Give credit where due if you copy this code!  Cheers :-)
'
'*******************************************************************

'Public Variables
Dim objExcel As Object, objBook As Object, objSheet As Object
Dim objDBase As Database, rsDBase As Recordset
Dim dbFileName As String, xlFileName As String, RowCount As Double

Private Sub cmdGetDB_Click()

Dim Counter As Integer

On Error GoTo Error_Handler

    'Open the 'file open' dialogue box
    cdiagdb.ShowOpen
    'Get / set the Access database file name and location
    lbldbFileName.Caption = cdiagdb.FileName
    dbFileName = cdiagdb.FileName
    'Open the database and get the table names
    Set objDBase = OpenDatabase(dbFileName, False, False)
    For Counter = 0 To objDBase.TableDefs.Count - 1
        If Left((objDBase.TableDefs(Counter).Name), 4) <> "MSys" Then
            List1.AddItem (objDBase.TableDefs(Counter).Name)
        End If
    Next Counter
Exit Sub

Error_Handler:
    If Err.Number = 32755 Then
    'User pressed Cancel
        DoEvents
    Else
        MsgBox Err.Description, vbCritical, "Error " & Err.Number
        List1.Clear
        lbldbFileName.Caption = ""
        dbFileName = ""
    End If
    Exit Sub
    
End Sub

Private Sub cmdGetSS_Click()

On Error GoTo Error_Handler

    'Open the 'file open' dialogue box
    cdiagxl.ShowOpen
    'Get /set the spreadsheet name and location
    lblxlFileName.Caption = cdiagxl.FileName
    xlFileName = cdiagxl.FileName
    Set objExcel = CreateObject("Excel.Application")
    Set objBook = objExcel.Workbooks.Open(xlFileName)
    'Select the first worksheet in the spreadsheet
    Set objSheet = objBook.Worksheets(1)
    
Exit Sub

Error_Handler:
    If Err.Number = 32755 Then
    'User pressed Cancel
        DoEvents
    Else
        MsgBox Err.Description, vbCritical, "Error " & Err.Number
        lblxlFileName.Caption = ""
        xlFileName = ""
    End If
    Exit Sub

End Sub

Private Sub cmdCopy_Click()

Dim Counter As Integer, InnerLoop As Integer

On Error GoTo Err_Handler

'Exit if nothing has been selected
If List1.SelCount = 0 Then
    Exit Sub
ElseIf dbFileName = "" Or xlFileName = "" Then
    'Exit if either a database or a spreadsheet have not been selected
    MsgBox "Please select a database and spreadsheet", vbInformation, "Error"
    Exit Sub
End If

    'Set the global row counter
    RowCount = 1
    'Activate the workbook/worksheet
    objSheet.Activate
    Range("A1").Activate
    'Select all cells
    Cells.Select
    'Clear the contents
    Selection.ClearContents
    Selection.Font.Bold = False
    Range("A1").Activate
    
'Loop through the list of tables / recordsets
For Counter = 0 To List1.ListCount - 1
    If List1.Selected(Counter) = False Then
        'Item was not selected
        DoEvents
    Else
        'Item was selected
        'Get the file name and open the recordset
        Set rsDBase = objDBase.OpenRecordset(List1.List(Counter))
        'Write the table name into the spreadsheet
        objSheet.Cells(RowCount, 1).Value = "Table : " & rsDBase.Name
        'Bold the table name
        objSheet.Cells(RowCount, 1).Font.Bold = True
        'Proceed to the next row
        RowCount = RowCount + 1
        'Loop through the field name and copy them into the spreadsheet
        For InnerLoop = 0 To rsDBase.Fields.Count - 1
            objSheet.Cells(RowCount, InnerLoop + 1).Value = rsDBase.Fields(InnerLoop).Name
        Next InnerLoop
        'Bold the field names
        objSheet.Range(objSheet.Cells(RowCount, 1), objSheet.Cells(RowCount, rsDBase.Fields.Count)).Font.Bold = True
        'Proceed to the next row
        RowCount = RowCount + 1
        'Copy the recordset into the spreadsheet
        objSheet.Cells(RowCount, 1).CopyFromRecordset rsDBase
        'Reset the row counter
        RowCount = RowCount + 1 + rsDBase.RecordCount
        'Clear the recordset
        Set rsDBase = Nothing
    End If
Next Counter

'Turn off the resume.xlw pop up alert
objExcel.DisplayAlerts = False
'Save the spreadsheet
objExcel.Save
'Close the spreadsheet
objExcel.ActiveWorkbook.Close True

MsgBox "Finished copying the selected table(s)", vbInformation, "Done"

Exit Sub

Err_Handler:
    MsgBox Err.Description, vbCritical, "Error " & Err.Number
    OrderlyClose
    Exit Sub

End Sub

Private Sub OrderlyClose()

On Error Resume Next

'Clear the GUI items on the form
List1.Clear
lbldbFileName.Caption = ""
lblxlFileName.Caption = ""
'Clear the objects and recordset
Set objSheet = Nothing
Set objBook = Nothing
Set objExcel = Nothing
Set rsDBase = Nothing
Set objDBase = Nothing
'Close Excel
objExcel.Quit

End Sub

Private Sub cmdExit_Click()

OrderlyClose
End

End Sub

This allows you to select a database, the list box then shows the tables available in the database and after you have selected one or more tables in the list box, click the 'Copy' button to copy the table names, field names and all of the contents of those tables into the first tab of the selected spreadsheet.

HTH, Andrew

 

[jannelyn010]

Re: vb 6.0 code to export data from access to excel

Hi

I have tested the following and it works fine...

Hi Andrew,

i have tried using your code regarding exporting data and i'm receiving an error, can you please help me? with all the research i made, yours is the most effective way since you provided a step by step process on how to make it work. please help me.

i hope you are still active as your post was posted year 2010.

i really hope you can help me.

thank you

 

[Andrew Fergus]

Re: vb 6.0 code to export data from access to excel

Hello

I believe that was designed for VB6, is that what you are using?

If it is not working, then it could be an issue with the versions of Excel and Access which have moved on quite a bit since 2006.

Are you able to step through the code to work out where it is failing?

I no longer have VB6 so will not be able to debug any issues given this is 12 and a half years later!

Andrew