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 routineOn 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 routineOn 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
'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
'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 routineOn 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 = 21190 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 routineOn 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...
Do you like this post? Please link back to this article by copying one of the codes below.
URL: HTML link code: BB (forum) link code:
No comments:
Post a Comment