I'm Having problems getting Access (2010) VBA to trap errors for connections to a SQL Server (2008) for linking tables.
I'm getting an error and popup windows, presumably from the ODBC Driver? I want to suppress these and handle the error myself. I know about the DAO.errors and ADO.errors collections but these don't help if I can't get the error to call my error handler!
The code below will give the error (unless you happen to have a table called myTable in a database called myDatabase on a server called myServer).
I've tried to use ADODB rather than DAO but could not get this to work at all.
Any ideas?
Public Function main()
Dim myDB As DAO.Database
Dim myTabledef As DAO.TableDef
On Error GoTo Err_handler
Set myDB = CurrentDb
Set myTabledef = myDB.CreateTableDef("l_table")
DoCmd.SetWarnings False
myTabledef.Connect = "odbc;driver=SqLServer;" & _
"DATABASE=myDB;SERVER=myServer;Trusted_Connection=Yes;"
myTabledef.SourceTableName = "MyTable"
myDB.TableDefs.Append myTabledef
DoCmd.SetWarnings True
Exit Function
Err_handler:
MsgBox Err.Number & " - " & Err.Description
End Function
I made a mistake in the posted code {Sql Server} became SqLServer when I posted it.
So the full code that gives the error is below:
Public Function main()
Dim myDB As DAO.Database
Dim myTabledef As DAO.TableDef
On Error GoTo Err_handler
Set myDB = CurrentDb
Set myTabledef = myDB.CreateTableDef("l_table")
DoCmd.SetWarnings False
myTabledef.Connect = "odbc;driver={Sql Server};" & _
"DATABASE=myDB;SERVER=myServer;Trusted_Connection=Yes;"
myTabledef.SourceTableName = "MyTable"
myDB.TableDefs.Append myTabledef
DoCmd.SetWarnings True
Exit Function
Err_handler:
MsgBox Err.Number & " - " & Err.Description
End Function
The error will not occur until you try to append the TableDef
Dim myDB As DAO.Database
Dim myTabledef As DAO.TableDef
On Error GoTo Err_handler
Set myDB = CurrentDb
scn = "odbc;driver=SqLServer;" & _
"DATABASE=myDB;SERVER=myServer;Trusted_Connection=Yes;"
Set myTabledef = myDB.CreateTableDef("l_table")
myTabledef.Connect = scn
myTabledef.SourceTableName = "Table1"
myDB.TableDefs.Append myTabledef
Err_handler:
Debug.Print Err.Number & " " & Err.Description
Related
I need only empty tables in access database. Additionally, it would be great if I can get empty tables from list of tables that I have (part of all tables). But listing all empty tables would work also.
You can use a small VBA function that checks this. Something like:
Function fIsTableEmpty(strTableName As String) As Boolean
On Error GoTo E_Handle
Dim db As DAO.Database
Dim rsData As DAO.Recordset
Dim strSQL As String
Set db = CurrentDb
strSQL = "SELECT COUNT(*) FROM [" & strTableName & "];"
Set rsData = db.OpenRecordset(strSQL)
fIsTableEmpty = True ' start by assuming that there are records
If Not (rsData.BOF And rsData.EOF) Then
If rsData(0) > 0 Then fIsTableEmpty = False
End If
fExit:
On Error Resume Next
rsData.Close
Set rsData = Nothing
Set db = Nothing
Exit Function
E_Handle:
MsgBox Err.Description & vbCrLf & vbCrLf & "fIsTableEmpty", vbOKOnly + vbCritical, "Error: " & Err.Number
Resume fExit
End Function
You can use DCount:
Public Function ListEmptyTables()
Dim Table As DAO.TableDef
For Each Table In CurrentDb.TableDefs
If Table.SourceTableName = "" Then
If DCount("*", Table.Name) = 0 Then
Debug.Print Table.Name
End If
End If
Next
End Function
Access 365/Windows 10
I’m getting the “Could not find installable ISAM” error which I believe means I’ve a problem with my connection string below.
I did a right click, export on a single Access table to the MySQL backend so that I could link it and verify the driver, server, port, database, etc. of that connection against the connection string in the function below. It all looks good. Can you see what I've done wrong?
I have 128 tables to migrate to MySQL and am looking for a efficient, repeatable process; I had high hopes for this code...
'''
Public Function fncExportTables() As Boolean
'Declare Variables...
Dim strCnn As String
Dim rs As Recordset
Dim db As Database
Dim strTp As String
Dim strOriginal As String
'The Connection String required to connect to MySQL.
'I THINK THIS IS THE PROBLEM
strCnn = "DRIVER={MySQL ODBC 8.0 Driver};" & _
"SERVER=myServer;" & _
"PORT=24299;" & _
"DATABASE=myDb;" & _
"USER=myUserName;" & _
"PASSWORD=myPassword;" & _
"OPTION=3;"
strTp = "ODBC Database"
'Trap any Errors...
On Error GoTo Error_fncExportTables
'Open a recordset from the table the conatains
'all the table names we want to Link from the
'MySQL Database.
Set db = CurrentDb
Set rs = db.OpenRecordset("qselMgr", dbOpenSnapshot)
With rs
'Fill the Recordset...
.MoveLast
.MoveFirst
'Enumerate through the Records...
Do Until rs.EOF
'Place the Table Name into the str string variable.
' FieldName (below) would be the Field name in your Access
' Table which holds the name of the MySQL Tables to Link.
strOriginal = !strOriginalName
'Make sure we are not dealing will an empty string..
If Len(strOriginal) > 0 Then
'Link the MySQL Table to this Database.
'ERROR TRIGGERS ON THE LINE BELOW
DoCmd.TransferDatabase acExport, strTp, strCnn, _
acTable, strOriginal, strOriginal
End If
'move to the next record...
.MoveNext
Loop
End With
'We're done...
Exit_fncExportTables:
'Clear Variables and close the db connection.
Set rs = Nothing
If Not db Is Nothing Then db.Close
Set db = Nothing
Exit Function
Error_fncExportTables:
'If there was an error then display the Error Msg.
MsgBox "Export Table Error:" & vbCr & vbCr & _
Err.Number & " - " & Err.Description, _
vbExclamation, "Export Table Error"
Err.Clear
Resume Exit_fncExportTables
End Function
'''
I have the following simple function to run an SQL passthrough query with ODBC:
Sub RunSQL(strSQL As String, DSN As String)
Dim db As DAO.Database
Dim qd As DAO.QueryDef
Dim rs As DAO.Recordset
Set db = CurrentDb
On Error Resume Next
db.QueryDefs.Delete "temp"
On Error GoTo 0
Set qd = db.CreateQueryDef("temp")
qd.Connect = "ODBC;DSN=" & DSN
qd.SQL = strSQL
qd.ODBCTimeout = 999
qd.ReturnsRecords = True
On Error GoTo Handler
Set rs = qd.OpenRecordset
Debug.Print rst!IALITM
db.QueryDefs.Delete "temp"
Exit Sub
Handler:
Dim dbeError As Error
For Each dbeError In DBEngine.Errors
Debug.Print "(" & dbeError.Number & "): " & dbeError.Description
Next
End Sub
The issue I'm having is that when I set the SQL, access automatically appends a semicolon to it as if using Access SQL syntax - the ODBC data source doesn't like this and returns an error. Is there any way I can stop Access from adding the ';', or remove it afterwards?
I've got a small Access program that looks up files names from a query ("qryImagesToRename"), goes through a loop and renames them. However, if an image already exists with the same name Access wants to rename it to, I receive
error 58 - File Already Exists
How do I ignore this error and continue with the loop? This my code:
Private Sub Command10_Click()
On Error GoTo Command10_Click_Error
Dim rs As DAO.Recordset
Dim db As DAO.Database
Dim strSQL As String
DoCmd.Hourglass True
Set db = CurrentDb
strSQL = "select * from qryImagesToRename"
Set rs = db.OpenRecordset(strSQL)
Do While Not rs.EOF
Name rs.Fields("From").Value As rs.Fields("To").Value
rs.MoveNext
Loop
DoCmd.Hourglass False
MsgBox "All matching files renamed"
On Error GoTo 0
Exit Sub
Command10_Click_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Command10_Click of VBA Document Form_frmRename - Please take a screenshot and email xxxxxx#xxxxxxx.com"
End Sub
If you are certain that you can ignore the error then you could use On Error Resume Next to ignore it and continue processing. Ensure that you add On Error Goto 0 as soon as you can, to reinstate the normal error processing.
On Error Resume Next
Do While Not rs.EOF
Name rs.Fields("From").Value As rs.Fields("To").Value
rs.MoveNext
Loop
On Error GoTo 0
This is most often a poor practice, but can be used if there is certainty about behaviour.
A better practice would be to check if the file already exists using Dir (or FileSystemObject) and skip it. Discussed here
Two particular solutions come to mind. The first, is in-line logic to check for the existing file, and skip that item, and the second is to put a case statement in the error handler. I have outlined the code below to have both options. I hope it helps.
Private Sub Command10_Click()
On Error GoTo Command10_Click_Error
Dim rs As DAO.Recordset
Dim db As DAO.Database
Dim strSQL As String
Dim fso as New FileSystemObject
DoCmd.Hourglass True
Set db = CurrentDb
strSQL = "select * from qryImagesToRename"
Set rs = db.OpenRecordset(strSQL)
Do While Not rs.EOF 'if you want to use the logic inline, use the check below
If fso.fileexists(rs.Fields("To").value) = false Then
Name rs.Fields("From").Value As rs.Fields("To").Value
End If
NextRecord: 'if you want to use the goto statement, use this
rs.MoveNext
Loop
DoCmd.Hourglass False
MsgBox "All matching files renamed"
On Error GoTo 0
Exit Sub
Command10_Click_Error:
Select case Err.number
Case 58
GoTo NextRecord
Case Else
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Command10_Click of VBA Document Form_frmRename - Please take a screenshot and email xxxxxx#xxxxxxx.com"
End select
End Sub
With the below code I set the linked table parameters, I set Usr and Pws but every time that program starts and I use the linked table I received this error:
and then
Now I have to unflag the trusted connection and input the Usr and Pws again.
What is causing this?
Public Function SetLinkedTablesTruck()
Dim db As DAO.Database
Dim tdf As TableDef
On Error GoTo ErrorHandler
Set db = CurrentDb
' Loop Table Defs
For Each tdf In db.TableDefs
If tdf.Name = "TruckOUT" Then
MsgBox tdf.Connect
tdf.Connect = "ODBC;DRIVER=SQL Server;SERVER=MYITSRV;DATABASE=dbItalianDb;TABLE=dbo.truckView;UID=UserView;PWD=UserView"
tdf.RefreshLink
db.TableDefs.Refresh
End If
Next
Set tdf = Nothing
Set db = Nothing
MsgBox "Tables Re-Linked"
ExitHandler:
Exit Function
ErrorHandler:
MsgBox "Error in SetLinkedTables : " & err.Description
Resume ExitHandler
End Function
You normally do not include the table name, thus:
tdf.Connect = "ODBC;DRIVER=SQL Server;SERVER=MYITSRV;DATABASE=dbItalianDb;UID=UserView;PWD=UserView"