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?
Related
I can connect to Oracle with a Passthrough query using ODBC to Oracle but the issue I have is because I have multiple databases that all use the same connections I want to store my credentials for the servers in an Excel encrypted file so nobody can see my passwords and only need to update in one place instead of every database but when I try and connect with my passthrough it doesnt work but does if I manually declare them in vba.
The Error Message is 3151 - ODBC - connection to '{Oracle in OraClientName}Server' failed
This is my code and dont know why it doesnt work? I tried with DSN and its the same result?
Function MyConnection()
On Error Resume Next
DoCmd.DeleteObject acQuery, "MY_TRANS"
Err.Clear
On Error GoTo 0
'''''GET EXCEL LOGIN DETAILS
Dim xlsApp
Set xlsApp = CreateObject("Excel.Application")
Dim WkBk As Excel.WorkBook
Set WkBk = xlsApp.WorkBooks.Open(FileName:="FILE LOCATION.xlsx", Password:="MYPASSWORD")
Dim LOGONNAME As String
Dim PWD As String
LOGONNAME = WkBk.Sheets(1).Range("B3").Value
PWD = WkBk.Sheets(1).Range("D3").Value
If Not (xlsApp Is Nothing) Then xlsApp.Quit
'end excel stuff
xlsApp.Quit
Set xlsApp = Nothing
'THIS WORKS IF I UNCOMMENT
'LOGONNAME = "MYNAME"
'PWD = "PASSWORD"
Dim db As DAO.Database
Dim ExtData As QueryDef
Dim strSQL As String
Set db = CurrentDb
strSQL = "SELECT * FROM TABLE"
Set ExtData = db.CreateQueryDef("MY_TRANS")
ServerName = "MYSERVER"
ExtData.Connect = "ODBC;DRIVER={Oracle in OraClientName};Server=" & ServerName & ";DBQ=DBQNAME;UID=" & LOGONNAME & ";Pwd=" & PWD & ""
ExtData.SQL = strSQL
DoCmd.OpenQuery "MY_TRANS"
DoCmd.Close acQuery, "MY_TRANS"
ExtData.Close
db.Close
Set db = Nothing
END FUNCTION
#Andre Your Comment fixed the issue The Answer is if you get false after typing Debug.Print LOGONNAME, (LOGONNAME = "MYNAME") and doing the same for the password then you will need to go into the excel and check the details are the same or retype and check again. This fixed the issue for me.
An import sub that has been created in access works OK but when DBfailonerror is added a compile error invalid use of property is encountered when the sub is run from the vb editor.
Any advice re: this would be most appreciated. Code is as follows:
Sub Importcl()
'DATA DECLARATIONS
Dim fso As New FileSystemObject
Dim t As TextStream
Dim strFilePath As String
Dim Cnr As String
Dim Cnri As String
Dim Cnrii As String
Dim Cnriii As String
Dim Sqlstr As String
Dim Db As DAO.Database
'SET COUNTERS TO ZERO
Cnr = 0
Cnri = 0
Cnrii = 0
Cnriii = 0
'Point to DB
Set Db = CurrentDb()
'SET TXT FILE PATH
strFilePath = "C:\Users\Vlad\CSV import\EV WORK\Book1.txt"
'ERROR HANLDER FOR TXT FILE PATH AND COUNTING OF TXT FILE LINE ITEMS
If fso.FileExists(strFilePath) Then
Set t = fso.OpenTextFile(strFilePath, ForReading, False)
Do While t.AtEndOfStream <> True
t.SkipLine
Cnr = Cnr + 1
Loop
t.Close
Else: MsgBox ("Txt File not Found - Check File Path")
Exit Sub
End If
'DISPLAY LINE RECORDS COUNTED IN TXT FILE TO BE ADDED TO TABLE
Debug.Print Cntr; " Incl header"
MsgBox (Cnr - 1 & " records to be added")
'COUNT & DISPLAY CURRENT RECORD COUNT IN TARGET TABLE
Cnri = DCount("[Case Date]", "All Caseload Data New")
If MsgBox(Cnri & " -Current Records in table- All Caseload Data New - Continue
with Import?", vbYesNo, "Import") = vbYes Then
Db.Execute _
"INSERT INTO [All Caseload Data New] SELECT * FROM[Text;FMT=Delimited;HDR=Yes;
DATABASE=C:\Users\Dev\CSV import\DEV WORK\].[Book1#txt];"
dbFailOnError
Db.TableDefs.Refresh
Else: Exit Sub
End If
Cnrii = DCount("[Case Date]", "All Caseload Data New")
Cnriii = Cnrii - Cnri
MsgBox (Cnriii & " New records added to table All Caseload Data New")
End Sub
With this code to start ...
Dim db As DAO.database
Dim strInsert As String
strInsert = "INSERT INTO tblFoo (some_text) VALUES ('bar');"
Set db = CurrentDb
Then these 2 Execute statements ..
db.Execute strInsert
dbFailOnError ' triggers error
db.Execute strInsert, dbFailOnError ' compiles without error
Include dbFailOnError on the same line as Execute. Placing dbFailOnError on a separate line triggers that "invalid use of property" compile error.
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 trying to import tables from a FoxPro 9.0 database into Access 2003. So far, from Google searches and many trials, the only way for me to connect to the tables is through an OLE DB connection programatically. I have set up 3 ODBC connections with different configurations but none of them work: I get "unspecified errors" that I can't find any information on.
With OLE DB I can succesfully connect to the FoxPro database, and import tables in ADO recordsets. The problem is that I can't save the recordset into new table in the local database using SQL. The ADO recordsets behave differently than tables, so I can't query them. The code below gives me a "type mismatch" error at DoCmd.RunCommand ("select * from " & rst & " INTO newClients").
Sub newAdoConn()
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim strSQL As String
Dim decision As Integer
Set cnn = New ADODB.Connection
cnn.ConnectionString = "Provider=vfpoledb;" & _
"Data Source=s:\jobinfo\data\jobinfo.dbc;" & _
"Mode=ReadWrite|Share Deny None;" & _
"Collating Sequence=MACHINE;" & _
"Password=''"
strSQL = "Select * from Jobs"
cnn.Open
Set rst = cnn.Execute("Select * from clients")
If rst.EOF = False Then
Do While Not rst.EOF
decision = MsgBox(rst.Fields!ID & " " & rst.Fields!fname & " " & rst.Fields!lname & vbCrLf & vbCrLf & "Continue?", vbYesNo)
If decision = vbYes Then
rst.MoveNext
Else
Exit Do
End If
Loop
End If
DoCmd.RunCommand ("select * from " & rst & " INTO newClients")
rst.Close
Set rst = Nothing
cnn.Close
Set cnn = Nothing
End Sub
I finally worked out a decent solution. It involves saving the ado recordset from memory to an excel file using the copyFromRecordset function, and then linking the file programmatically to a table in excel using the TransferSpreadsheet()...
Sub saveToExcel()
Dim cnn As ADODB.Connection
'declare variables
Dim rs As ADODB.Recordset
Dim strSQL As String
Dim decision As Integer
Dim colIndex As Integer
' Dim fso As New FileSystemObject
' Dim aFile As File
'set up connection to foxpro database
Set cnn = New ADODB.Connection
cnn.ConnectionString = "Provider=vfpoledb;" & _
"Data Source=s:\jobinfo\data\jobinfo.dbc;" & _
"Mode=ReadWrite|Share Deny None;" & _
"Collating Sequence=MACHINE;" & _
"Password=''"
cnn.Open
Set rs = cnn.Execute("Select * from clients")
'Create a new workbook in Excel
Dim oExcel As Object
Dim oBook As Object
Dim oSheet As Object
Set oExcel = CreateObject("Excel.Application")
Set oBook = oExcel.Workbooks.Add
Set oSheet = oBook.Worksheets(1)
oSheet.Name = "clients"
' Copy the column headers to the destination worksheet
For colIndex = 0 To rs.Fields.Count - 1
oSheet.Cells(1, colIndex + 1).Value = rs.Fields(colIndex).Name
Next
'Transfer the data to Excel
oSheet.Range("A2").CopyFromRecordset rs
' Format the sheet bold and auto width of columns
oSheet.Rows(1).Font.Bold = True
oSheet.UsedRange.Columns.AutoFit
'delete file if it exists - enable scripting runtime model for this to run
'If (fso.FileExists("C:\Documents and Settings\user\Desktop\clients.xls")) Then
' aFile = fso.GetFile("C:\Documents and Settings\user\Desktop\clients.xls")
' aFile.Delete
'End If
'Save the Workbook and Quit Excel
oBook.SaveAs "C:\Documents and Settings\user\Desktop\clients.xls"
oExcel.Quit
'Close the connection
rs.Close
cnn.Close
MsgBox ("Exporting Clients Done")
'link table to excel file
DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel5, "clientsTest", "C:\Documents and Settings\user\Desktop\clients.xls", True
End Sub
What you will have to do is open the FoxPro table as a recordset and open the local table as another recordset. You can then loop through the FoxPro recordset and do something like this
Do until FoxProRst.EOF
LocatRst.AddNew
LocalRst!SomeField1=FoxProRst!SomeField1
LocalRst!SomeField2=FoxProRst!SomeField2
LocalRst!SomeField3=FoxProRst!SomeField3
LocalRst.Update
FoxProRst.MoveNext
Loop
It might not be the quickest way but it will work
Let me just sketch another approach with SQL queries, that could simplify:
'...
'not required for first time test:
'cnn.Execute("DROP TABLE MyNewTable")
'...
'create the new table in the destination Access database
cnn.Execute("CREATE TABLE MyNewTable (MyField1 int, MyField2 VARCHAR(20), MyField3 Int)")
'insert data in the new table from a select query to the original table
Dim sSQL as string, MyOriginalDBPath as String
sSQL = "INSERT INTO MyNewTable (MyField1, MyField2, MyField3) SELECT OriginalField1, OriginalField2, OriginalField3 FROM [" & MyOriginalDBPath & ";PWD=123].clients"
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
rs.Open sSQL, cnn, adOpenForwardOnly, adLockReadOnly, adCmdText
'...
Note: this 'draft' idea assumes that the connection string is made to the Access database and the connection to the original database would be inside the SQL string, but i have not idea about the correct sintaxis. I have only tested this approach with different access databases.
Note that this is for Access: ...[" & MyOriginalDBPath & ";PWD=123]...
The Jet database engine can reference external databases in SQL statements by using a special syntax that has three different formats:
[Full path to Microsoft Access database].[Table Name]
[ISAM Name;ISAM Connection String].[Table Name]
[ODBC;ODBC Connection String].[Table Name]
...
You can use an ODBC Data Source Name (DSN) or a DSN-less connection string:
DSN: [odbc;DSN=;UID=;PWD=]
DSN-less: [odbc;Driver={SQL Server};Server=;Database=;
UID=;PWD=]
Some references:
Querying data by joining two tables in two database on different servers
C# - Join tables from two different databases using different ODBC drivers
Why not use ODBC to link to the table? http://support.microsoft.com/kb/225861
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.