QuickBooks Tables in Access w/ QODBC Form Part 2

This is part of a tutorial explaining how to create a Microsoft® Access form that imports QuickBooks® tables into using QODBC with a button click. The tutorial begins here.


Navigate to the Visual Basic Editor. If you do not know how to do this, see my other site: The Generic Database:

            Appendix C: How to Open the Visual Basic Editor

            http://www.thegenericdatabase.com/2011/09/appendix-c-opening-visual-basic-editor.html
 

Double-click the form you created in the Project Explorer. If you do not see the Project Explorer, select it from the View Menu of the Visual Basic Editor menu bar.

Code

Paste this code into the Code Window of the Visual Basic Editor:

Option Explicit

Private Sub cmdReloadColumnsTable_Click()

'if an error occurs, go to the error routine
On Error GoTo cmdReloadColumnsTable_Click_err
'use the information from the Table listbox to determine the name of the table to look for
'this code names all imported QuickBooks tables with a prefix of "tblQODBC_"
'this way you will know that any tables with a prefix of tblQODBC_ may be deleted
'because you can reload them using this form
'so we are passing the table name to the ReloadTableFields routine
10     ReloadTableFields ("tblQODBC_" & lstTables.Column(0, lstTables.ListIndex))
cmdReloadColumnsTable_Click_exit:
Exit Sub
cmdReloadColumnsTable_Click_err:
'fncWriteError writes error information to a message box and to the immediate window
Call fncWriteError(Form.Name, "", "Private Sub cmdReloadColumnsTable_Click", Err.Number, Err.Description, Erl, "")
GoTo cmdReloadColumnsTable_Click_exit
End Sub

Private Sub cmdReloadTables_Click()

'if an error occurs, go to the error routine
On Error GoTo cmdReloadTables_Click_err
'before reloading the table, you must set the listbox rowsource to nothing
'if you do not do this, you will produce an error that you cannot delete the table
'because it is already in use
100     lstTables.RowSource = ""
'with the rowsource set to nothing, go to the ReloadTables routine to import
'the QuickBooks table information and put it into a Microsoft Access table
110     ReloadTables
'now that the table has been reloaded, you may se the lstbox rowsource to the new table
120     lstTables.RowSource = "qbtables"
cmdReloadTables_Click_exit:

Exit Sub

cmdReloadTables_Click_err:
'fncWriteError writes error information to a message box and to the immediate window
Call fncWriteError(Form.Name, "", "Private Sub cmdReloadTables_Click", Err.Number, Err.Description, Erl, "")
GoTo cmdReloadTables_Click_exit
End Sub

Private Sub ReloadTables()
'if an error occurs, go to the error routine
On Error GoTo ReloadTables_err
'declare variables for database, QueryDef and the query name
10      Dim db As DAO.Database, qDef As DAO.QueryDef, qName As String
'assign the name of the query to the string variable
20      qName = "qryTemp_Tables"
'call a function that deletes the temporary query if it already exists
'this query first checks to see if one with the same name exists and if it does, deletes it
'if you try to delete a query that doesn't exist, Visual Basic will present
'an error message telling you it cannot find the query
30      Call fncDeleteQuery(qName)
'set the database - assumes you are working in the current database
40      Set db = CurrentDb
'create the query using the name you assigned above
50      Set qDef = db.CreateQueryDef(qName)
'QODBCConnect is a function that sets the QODBC connection string
'this avoids having to remember it every time you need to use it
'you can simply write "qDef.Connect = " and then type out your connection string if you prefer
60      qDef.Connect = QODBCConnect
'set the query to return records
70      qDef.ReturnsRecords = True
'create the sql string and put it into the query
80      qDef.sql = "sp_tables"
'before placing query results into a new table, you may
'use fncDeleteTable to delete the table if it exists
90      Call fncDeleteTable("qbTables")
'Turn off warnings so you don't get one for overwriting an existing table
100     DoCmd.SetWarnings False
'here the user will not know what is going on if their computer is slow
'you may open a form telling the user you are extracting
'data from QuickBooks and then close the form when you are finished
110     DoCmd.RunSQL "select tablename,remarks  into qbTables from " & qName
'delete the pass thru query because you don't need it now
120     DoCmd.DeleteObject acQuery, qName
'turn warnings aback on
130     DoCmd.SetWarnings True
'use this line to return to from the error routine so if an error occurs
ReloadTables_exit:
'you are finished with qDef and db so set them to nothing
'if you do not set db to nothing, you may find Access running
'in your task manager even after you close the database
150     Set qDef = Nothing
160     Set db = Nothing
'exit the function - you are finished
Exit Sub
ReloadTables_err:
'fncWriteError writes error information to a message box and to the immediate window
Call fncWriteError("", "Functions Customers", "Private Sub ReloadTables", Err.Number, Err.Description, Erl, "")
'return to the exit line to set qDef and db to nothing before exiting the function
GoTo ReloadTables_exit
End Sub

Private Sub Form_Close()
'set the listbox rowsources to nothing
'if a user deletes the tables used for rowsources, an error message will
'display when trying to open the form because the rowsources do not exits
lstFields = ""
lstTables = ""
End Sub

Private Sub Form_Open(Cancel As Integer)

'if an error occurs, go to the error routine
On Error GoTo Form_Open_err
'set lblRemarks to nothing
110     lblRemarks.Caption = ""
'set the listbox rowsources to nothing in case the rowsource tables were deleted
'you will check to see if they exist before use them as rowsources
120     lstTables.RowSource = ""
'setting column properites - easier than explaining in a post
130     lstTables.ColumnCount = 1
140     lstTables.ColumnWidths = lstTables.Width
150     lstTables.RowSourceType = "Table/query"
'now you check to see if the table qbTables exists before setting the listbox rowsource
160     If fExistTable("qbtables") = True Then lstTables.RowSource = "qbtables"

170     lstFields.RowSource = ""

180     lstFields.ColumnCount = 21
190     lstFields.RowSourceType = "Table/query"
200     lstFields.ColumnHeads = True

Form_Open_exit:

Exit Sub

Form_Open_err:
'fncWriteError writes error information to a message box and to the immediate window
Call fncWriteError(Form.Name, "", "Private Sub Form_Open", Err.Number, Err.Description, Erl, "")
'return to the exit line to exit the function
GoTo Form_Open_exit

End Sub

Private Sub lstTables_Click()

'if an error occurs, go to the error routine
On Error GoTo lstTables_Click_err
'set the label caption to the name of the table and the QODBC remarks
'the remarks explain about the table for the user
'this information comes from lstTables.ListIndex - which the line the user selected
100     lblRemarks.Caption = lstTables.Column(0, lstTables.ListIndex) & ": " & lstTables.Column(1, lstTables.ListIndex)
'declare a variable to hold the name of the table that was selected in the listbox
110     Dim strTable As String
'assign the prefix "tblQODBC_" plus the table name from the listbox to strTable
'this information will passed to the subroutine that creates the Columns table
120     strTable = "tblQODBC_" & lstTables.Column(0, lstTables.ListIndex)
'check to see if this columns table already exists

130     If fExistTable(strTable) = True Then

'the columns table exists so no need to create one
'set the columns listbox rowsource to the existing table
140          lstFields.RowSource = strTable
150     Else
'else it does not exist to go to the subroutine to create it
160          ReloadTableFields ("tblQODBC_" & lstTables.Column(0, lstTables.ListIndex))
170     End If

lstTables_Click_exit:

Exit Sub

lstTables_Click_err:
'fncWriteError writes error information to a message box and to the immediate window
Call fncWriteError(Form.Name, "", "Private Sub lstTables_Click", Err.Number, Err.Description, Erl, "")
'return to the exit line to exit the function
GoTo lstTables_Click_exit
End Sub



Private Sub ReloadTableFields(strTable As String)
'if an error occurs, go to the error routine
On Error GoTo ReloadTableFields_err
100     lstFields.RowSource = ""
'declare variables for database, QueryDef and the query name
110     Dim db As DAO.Database, qDef As DAO.QueryDef, qName As String
'assign the name of the query to the string variable
120     qName = "qryTemp_TableFields"
'call a function that deletes the temporary query if it already exists
'trying to delete a query that doesn't exist will produce an error
130     Call fncDeleteQuery(qName)
'set the database - assumes you are working in the current database
140     Set db = CurrentDb
'create the query using the name you assigned above
150     Set qDef = db.CreateQueryDef(qName)
'QODBCConnect is a function that sets the QODBC connection string
'you can simply write "qDef.Connect = " and then type out your connection string if you prefer
160     qDef.Connect = QODBCConnect
'set the query to return records
170     qDef.ReturnsRecords = True
'create the sql string and put it into the query
180     qDef.sql = "sp_columns " & lstTables.Column(0, lstTables.ListIndex)
'before creating the table, use a function to delete the table if it already exists
190     Call fncDeleteTable(strTable)
'Turn off warnings so you don't get one for overwriting an existing table
'you could simply create the pass thru query but if the user deletes it
'will they know how to recreate it? best to create it programmatically
200     DoCmd.SetWarnings False
'run sql to create the new table
210     DoCmd.RunSQL "select *  into " & strTable & " from " & qName
'delete the pass thru query because you don't need it now
220     DoCmd.DeleteObject acQuery, qName
'turn warnings aback on
230     DoCmd.SetWarnings True
'set the listbox rowsource to the new table
240     lstFields.RowSource = strTable
'return here from the error routine
ReloadTableFields_exit:
        'you are finished with qDef and db so set them to nothing
        'if you do not set db to nothing, you may find Access running
        'in your task manager even after you close the database
250     Set qDef = Nothing
260     Set db = Nothing
'exit the function - are finished
Exit Sub
ReloadTableFields_err:
'fncWriteError writes error information to a message box and to the immediate window
Call fncWriteError("", "Functions Customers", "Private Sub ReloadTableFields", Err.Number, Err.Description, Erl, "")
'return to the exit line to exit the function
GoTo ReloadTableFields_exit
End Sub

Continue to Part 3...