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"
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
I am trying to call a function when running a sub proecudere, however, I keep getting an error message saying "Argument not optional", can someone help?
Code as follows:
Public Sub ret()
Dim FSO As New Scripting.FileSystemObject
Const cstrFolderF = "\\tblSCFLAGCHECKER.txt"
If FSO.FileExists(cstrFolderF) Then
DoCmd.RunSQL "DELETE * FROM [tblSCFLAG_CHECKER]"
DoCmd.TransferText acImportDelim, "tblSCFLAG_CHECKER", "tblSCFLAG_CHECKER", cstrFolderF, True
changefieldnames
Else
'SCAnswer = MsgBox("SC Flags does not exist, do you wish to continue?", vbYesNo Or vbQuestion Or vbDefaultButton2)
'If SCAnswer = vbNo Then Exit Sub
End If
End Sub
Private Sub changefieldnames()
Dim db As Database
Dim tdf As TableDef
Dim n As Object
Set db = CurrentDb
Set tdf = db.TableDefs("tblSCFLAG_CHECKER")
For Each n In tdf.Fields
If n.Name = "?Person ID" Then n.Name = "Person ID"
Next n
Set tdf = Nothing
Set db = Nothing
End Sub
Your changefieldnames function requires two arguments but you give none in the call after
DoCmd.TransferText acImportDelim, "tblSCFLAG_CHECKER", "tblSCFLAG_CHECKER", cstrFolderF, True
changefieldnames
As a remark: you should try to debug your code instead of just posting an error without even stating where exactly the error occurs.
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
I'm performing a data cleansing operation on an access database. I have several duplicate records in a table that I want to consolidate down into one single record. In doing this I will need to update all references to the records that I will be consolidating.
If I know the column name that holds the record id is there a way to find all of the tables in access that contain this column?
You can examine the TableDefs collection and determine which tables contain a field with a given name.
Public Sub TablesWithField(ByVal pName As String)
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim strMsg As String
Dim strName As String
On Error GoTo ErrorHandler
Set db = CurrentDb
For Each tdf In db.TableDefs
strName = vbNullString
'ignore system and temporary tables '
If Not (tdf.name Like "MSys*" Or tdf.name Like "~*") Then
strName = tdf.Fields(pName).name
If Len(strName) > 0 Then
Debug.Print tdf.name & ": " & pName
End If
End If
Next tdf
ExitHere:
On Error GoTo 0
Set tdf = Nothing
Set db = Nothing
Exit Sub
ErrorHandler:
Select Case Err.Number
Case 3265 'Item not found in this collection. '
Resume Next
Case Else
strMsg = "Error " & Err.Number & " (" & Err.description _
& ") in procedure TablesWithField"
MsgBox strMsg
GoTo ExitHere
End Select
End Sub
Short answer: Yes. And there are many ways to skin that cat. Two ideas:
(1) Via VBA, make use of: Application.CurrentDb.TableDefs(i).Fields(j).Name
(2) Via Tools==>Analyze==>Documenter, make a report and then search its output (Publish it with MS Word).
Sorry, but Access isn't built like MS SQL Server or DB2 - the MSys* tables really aren't set up for querying table schemas like that. However, others have VBA based solutions that look useful.
You can use Schemas, not exactly a query, but similar:
Function ListTablesContainingField(SelectFieldName) As String
'Tables returned will include linked tables
'I have added a little error coding. I don't normally do that
'for examples, so don't read anything into it :)
Dim cn As New ADODB.Connection
Dim rs As ADODB.Recordset
Dim strTempList As String
On Error GoTo Error_Trap
Set cn = CurrentProject.Connection
'Get names of all tables that have a column called <SelectFieldName>
Set rs = cn.OpenSchema(adSchemaColumns, _
Array(Empty, Empty, Empty, SelectFieldName))
'List the tables that have been selected
While Not rs.EOF
'Exclude MS system tables
If Left(rs!Table_Name, 4) <> "MSys" Then
strTempList = strTempList & "," & rs!Table_Name
End If
rs.MoveNext
Wend
ListTablesContainingField = Mid(strTempList, 2)
Exit_Here:
rs.Close
Set cn = Nothing
Exit Function
Error_Trap:
MsgBox Err.Description
Resume Exit_Here
End Function
I'm executing a query like this
select field from table;
In that query, there is a loop running on many tables. So, if the field is not present in a table I get a
Runtime Error 3061
How can I by pass this error such as that on this error flow should go to another point?
This is the code I have recently after going through this forum.
Option Explicit
Private Sub UpdateNulls()
Dim rs2 As DAO.Recordset
Dim tdf As DAO.TableDef
Dim db As Database
Dim varii As Variant, strField As String
Dim strsql As String, strsql2 As String, strsql3 As String
Dim astrFields As Variant
Dim intIx As Integer
Dim field As Variant
Dim astrvalidcodes As Variant
Dim found As Boolean
Dim v As Variant
Open "C:\Documents and Settings\Desktop\testfile.txt" For Input As #1
varii = ""
Do While Not EOF(1)
Line Input #1, strField
varii = varii & "," & strField
Loop
Close #1
astrFields = Split(varii, ",") 'Element 0 empty
For intIx = 1 To UBound(astrFields)
'Function ListFieldDescriptions()
Dim cn As New ADODB.Connection, cn2 As New ADODB.Connection
Dim rs As ADODB.Recordset, rs3 As ADODB.Recordset
Dim connString As String
Dim SelectFieldName
Set cn = CurrentProject.Connection
SelectFieldName = astrFields(intIx)
Set rs = cn.OpenSchema(adSchemaColumns, Array(Empty, Empty, Empty, SelectFieldName))
'Show the tables that have been selected '
While Not rs.EOF
'Exclude MS system tables '
If Left(rs!Table_Name, 4) <> "MSys" Then
strsql = "Select t.* From [" & rs!Table_Name & "] t Inner Join 01UMWELT On t.fall = [01UMWELT].fall Where [01UMWELT].Status = 4"
End If
Set rs3 = CurrentDb.OpenRecordset(strsql)
'End Function
strsql2 = "SELECT label.validcode FROM variablen s INNER JOIN label ON s.id=label.variablenid WHERE varname='" & astrFields(intIx) & "'"
Set db = OpenDatabase("C:\Documents and Settings\Desktop\Codebook.mdb")
Set rs2 = db.OpenRecordset(strsql2)
With rs2
.MoveLast
.MoveFirst
astrvalidcodes = rs2.GetRows(.RecordCount)
.Close '
End With
With rs3
.MoveFirst
While Not rs3.EOF
found = False
For Each v In astrvalidcodes
If v = .Fields(0) Then
found = True
Debug.Print .Fields(0)
Debug.Print .Fields(1)
Exit For
End If
Next
If Not found Then
msgbox "xxxxxxxxxxxxxxxx"
End If
End If
.MoveNext
Wend
End With
On Error GoTo 0 'End of special handling
Wend
Next intIx
End Sub
I'm getting a
Type Mismatch Runtime Error
in Set rs3 = CurrentDb.OpenRecordset(strsql)
I guess I'm mixing up ado and dao but I'm not certainly sure where it is.
Use the On Error statement that VBA supplies:
Sub TableTest
On Error Goto TableTest_Error
' ...code that can fail... '
Exit Sub
:TableTest_Error
If Err.Number = 3061 Then
Err.Clear()
DoSomething()
Else
MsgBox Err.Description ' or whatever you find appropriate '
End If
End Sub
Alternatively, you can switch off automatic error handling (e.g. breaking execution and displaying an error message) on a line-by-line basis:
Sub TableTest
' ... fail-safe code ... '
On Error Resume Next
' ...code that can fail... '
If Err.Number = 3061 Then
Err.Clear()
DoSomething()
Else
MsgBox Err.Description
End If
On Error Goto 0
' ...mode fail-safe code... '
End Sub
There are these statements available:
On Error Resume Next switches off VBA-integrated error handling (message box etc.) completely, execution simply resumes on the next line. Be sure to check for an error very early after you've used that, as a dangling error can disrupt the normal execution flow. Clear the error as soon as you caught it to prevent that.
On Error Goto <Jump Label> resumes execution at a given label, primarily used for per-function error handlers that catch all sorts of errors.
On Error Goto <Line Number> resumes at a given line number. Stay away from that, it's not useful, even dangerous.
On Error Goto 0 it's close cousin. Reinstates the VBA integrated error management (message box etc.)
EDIT
From the edited qestion, this is my proposal to solve your problem.
For Each FieldName In FieldNames ' assuming you have some looping construct here '
strsql3 = "SELECT " & FieldName & " FROM table"
On Error Resume Next
Set rs3 = CurrentDb.OpenRecordset(strsql3)
If Err.Number = 3061 Then
' Do nothing. We dont care about this error '
Err.Clear
Else
MsgBox "Uncaught error number " & Err.Number & " (" & Err.Description & ")"
Err.Clear
End If
On Error GoTo 0
Next FieldName
Be sure to clear the error in any case before you go on with a loop in the same Sub or Function. As I said, a dangling error causes code flow to become unexpected!
Rather than trapping the error, why not use the TableDefs to check for the field or use a mixture of ADO and DAO? ADO Schemas can provide a list of tables that contain the required field:
Function ListTablesContainingField()
Dim cn As New ADODB.Connection, cn2 As New ADODB.Connection
Dim rs As ADODB.Recordset, rs2 As ADODB.Recordset
Dim connString As String
Dim SelectFieldName
Set cn = CurrentProject.Connection
SelectFieldName = "Fall" 'For tksy '
'Get names of all tables that have a column called 'ID' '
Set rs = cn.OpenSchema(adSchemaColumns, _
Array(Empty, Empty, Empty, SelectFieldName))
'Show the tables that have been selected '
While Not rs.EOF
'Exclude MS system tables '
If Left(rs!Table_Name, 4) <> "MSys" Then
' Edit for tksy, who is using more than one forum '
If tdf.Name = "01UMWELT" Then
strSQL = "Select * From 01UMWELT Where Status = 5"
Else
strSQL = "Select a.* From [" & rs!Table_Name _
& "] a Inner Join 01UMWELT On a.fall = 01UMWELT.fall " _
& "Where 01UMWELT.Status = 5"
End If
Set rs2 = CurrentDb.OpenRecordset(strSQL)
Do While Not rs2.EOF
For i = 0 To rs2.Fields.Count - 1
If IsNull(rs2.Fields(i)) Then
rs2.Edit
rs2.Fields(i) = 111111
rs2.Update
End If
Next
rs2.MoveNext
Loop
End If
rs.MoveNext
Wend
rs.Close
Set cn = Nothing
End Function
Try this:
On Error Resume Next ' If an error occurs, move to next statement.
...statement that tries the select...
If (Err <> 0) Then
...act on error, or simply ignore if necessary...
End If
On Error Goto 0 ' Reset error handling to previous state.