Linking to Oracle tables in Access using VB6: Error 3000? - oracle

I am trying to link an Oracle table to access using the following Visual Basic 6.0 code:
Dim objApp, objDB, objTable As Object
Dim strFile, strConnect, strLocalTable, strServerTable As String
strFile = "C:\path\to\base.mdb"
strLocalTable = "local"
strServerTable = "BASE.TABLE_NAME"
strConnect = "ODBC;Driver={Microsoft ODBC for Oracle};ConnectString=name.world;Uid=username;Pwd=password;"
Set objApp = CreateObject("Access.Application")
objApp.OpenCurrentDatabase strFile
Set objDB = objApp.CurrentDb()
Set objTable = objDB.CreateTableDef(strLocalTable)
objTable.Connect = strConnect
objTable.SourceTableName = strServerTable
objDB.TableDefs.Append objTable 'Generates 3000 Error
objDB.TableDefs.Refresh
On the second to last row I get (loosely translated from swedish by me) "Run time error 3000: Reserved error (-7778). There is no message for this error."
Any ideas on why this may be? I am told this code has worked before, so it could possibly be some kind of version conflict with updated software. The database is in Access 2000 format, and Access 2013 is installed on the computer (however, saving the database as Access 2013 does not help). Or is there something wrong with the connection string perhaps?
EDIT: I tried using a DSN in the connection string:
strConnect = "ODBC;Driver={Microsoft ODBC for Oracle};DSN='test';"
I get the same error, even though I can use that very DSN to link the tables manually in Access.
Also (as I stated in the comments) changing some of the information in the connection string (like deliberately providing an incorrect username) leads to a different error (3146: Connection failed). This leads me to believe that the connection to the database works, since it seems to be able to differentiate between good and bad credentials.

Try this connection string and leave out the 'world.' part
ODBC;DRIVER={Oracle in orahome32};UID=userId;PWD=password;SERVER=servername;dbq=servername
(I was having trouble earlier today with connections that left the dbq out)
Or maybe your existing one will work, but regardless...I think Access likes you to create the table default in one swoop and not break things up so.....
Instead of this:
Set objTable = objDB.CreateTableDef(strLocalTable)
objTable.Connect = strConnect
objTable.SourceTableName = strServerTable
Try This:
Set objTable = objDB.CreateTableDef(strLocalTable, dbAttachSavePWD, strServerTable, strConnect)
(NOTE: the dbAttachSavePWD will help avoid users getting prompted for password every time they touch the table; leave it out if that is not desired)

Related

"Identity cannot be determined for newly inserted rows" after ADO RecordSet AddNew and Update

I'm getting the error message "Identity cannot be determined for newly inserted rows" when I attempt to edit a field for an ADO RecordSet record after calling AddNew and Update in a .vbs file. However, I'm able to access the primary key that was returned from the database.
I'm not looking for a workaround (e.g. closing the recordset and retrieving the record by its ID), I just really would like to understand why this error is occurring. I've simplified my code in a test file to rule out any other issues. What you see below is the exact code I'm executing with no files included (I've stripped the credentials out of the connection string).
Dim connString : connString = "Provider=SQLOLEDB.1;Persist Security Info=True;Data Source=localhost;Initial Catalog=;User Id=;Password="
Dim conn, rsTaskLog, sSQL
Set conn = CreateObject("ADODB.Connection")
conn.Open connString
' Create a new task log entry.
Set rsTaskLog = CreateObject("ADODB.Recordset")
sSQL = "SELECT * FROM Test"
rsTaskLog.Open sSQL, conn, 1, 3, 1 'adOpenKeyset, adLockOptimistic, adCmdText
rsTaskLog.AddNew
rsTaskLog.Update
' Set the task log result.
rsTaskLog.Fields("test_int").Value = 1 ' Error occurs on this line.
rsTaskLog.Update
rsTaskLog.Close
Set rsTaskLog = Nothing
UPDATE:
I was able to make this code work by adding the following line after the first update:
rsTaskLog.AbsolutePosition = rsTaskLog.AbsolutePosition
Something about moving the current record is putting the RecordSet back into a state where it can be edited (MoveLast and MoveFirst also worked). Anyone have any idea what is going on behind the scenes that is causing this?
The solution I came up with was adding the following line of code right after the first Update is called on the RecordSet:
rsTaskLog.AbsolutePosition = rsTaskLog.AbsolutePosition
For some reason moving the cursor position puts the RecordSet back into a state where Update can be called again without generating the error (MoveFirst and MoveLast also worked, but by setting the AbsolutePosition to itself we're able to maintain the current position). I'm not entirely sure what is going on behind the scenes here, feel free to elaborate if you know in the comments.

How do I get Active Directory's LDAP server url using windows API?

I've been looking for a way to get Active Directory's LDAP server url from code running as domain user. The code needs to work correctly in situation with disjoint namespace, if possible. It's unmanaged code so any .NET solutions are not an option unfortunately.
For some reason serverless binding doesn't seem to be working in this case with ADO query returning unhelpful One or more errors occurred during processing of command error when using LDAP://DC=mycompany,DC=local (that's the value of the defaultNamingContext attribute of rootDSE object).
Using the LOGONSERVER and USERDNSDOMAIN environment variables doesn't appear to be an option either because the code also needs to be able to run under the SYSTEM account and there are no such variables there.
Any ideas or hints or specific RTFM advice will be much appreciated.
Update: The DNSHostName attribute of rootDSE seems to be what I need.
I use this Visual Basic Script (VBS). Save the code as .vbs file and use ANSI charset. This script is old, but this can guide you to a better solution.
Set cn = CreateObject("ADODB.Connection")
Set cmd= CreateObject("ADODB.Command")
cn.Provider = "ADsDSOObject;"
cn.open
cmd.ActiveConnection = cn
' Root DSE required to get the default configuration naming context to
' be used as the root of the seach
set objRootDSE = getobject("LDAP://RootDSE")
' Construct the LDAP query that will find all the domain controllers
' in the domain
ldapQuery = "<LDAP://" & objRootDSE.Get("ConfigurationNamingContext") & _
">;((objectClass=nTDSDSA));ADsPath;subtree"
cmd.CommandText = ldapQuery
cmd.Properties("Page Size") = 1000
Set rs = cmd.Execute
do while rs.EOF <> True and rs.BOF <> True
' Bind to the domain controller computer object
' (This is the parent object of the result from the query)
set objDC = getobject(getobject(rs(0)).Parent)
wscript.echo objDC.dNSHostName
rs.MoveNext
Loop
cn.close
The DNSHostName attribute of rootDSE seems to be what I need.

"Method or Data Member Not Found" When Trying to Execute Database Code

I have a test project I'm using to familiarise myself with VB6. Just a listbox, a button to get info, and a button to clear info:
Code:
Option Explicit
Private Sub btnGet_Click()
lstResults.DataSource = GetMenuItems
End Sub
Private Sub btnClear_Click()
lstResults.Clear
End Sub
Public Function GetMenuItems() As ADODB.Recordset
Dim rs As ADODB.Recordset
Dim conn As New ADODB.Connection
conn.ConnectionString = "File Name=C:\connString.udl"
Dim cmd As New ADODB.Command
Set cmd.ActiveConnection = conn
cmd.CommandType = adCmdStoredProc
cmd.CommandText = "dbo.GetMenuItems"
Set rs = cmd.Execute()
GetMenuItems = rs
End Function
The following error appears when I click the Get Items button (btnGet):
Compile Error: Method or Data Member Not Found
At first I thought it might be something to do with the event/button, that some sort of binding between them wasn't present. But just putting in something like "MsgBox("Hello")" works fine. Yet it doesn't even seems to get to the line where the GetMenuItems function is called before throwing the error.
This being my first whirl with VB, I'm a little stumped.
EDIT - I've had a look at the UDL file I was using too. Tested that and its connecting ok on its own.
In Sub btnGet_Click, use
Set lstResults.DataSource = GetMenuItems
Assigning object references without using Set is hardly ever the right thing to do. For what it's worth, omitting Set references the left-hand side's default property; this was part of VB6 (OK, VB4, when classes were introduced) as a help to VB3 programmers, before there were such things as objects. Whatever kind of object lstResults.DataSource returns likely does not have a default property, leading to the "Method or data member not found" error.
You've got a private sub btnGet_Click() calling a public function GetMenuItems(), which may cause problems.
Also I'm not sure you can use a udl as the connection string. Instead, open the UDL (you may need to change the file extension to .txt temporarily), take the connection string out, and use that in place of the file name.
Also, check the stored procedure exists dbo.GetMenuItems

I cannot obtain Metadata using ADO/ADOX

I am trying to obtain meta data based on a users selection. I am using the ADODB namespace to provide a connection to the database and a recordset to retrieve data from it. I have set up a connection and tested it, this works fine, but the retrieval of the data is not working.
Here is the main segment:
con.Open()
cat.ActiveConnection = con
Select Case chk.Tag
Case "Yes"
For Each modMainFunctions.tbl In cat.Tables
If tbl.Type = "TABLE" Then
frmMain.lstTables.Items.Add(tbl.Name)
End If
Next
End Select
Essentially, I am checking if a particular checkbox has been selected, if it is has "i.e. case "yes" then I am trying to retrieve the Database TABLES from the provided database. However, the compiler doesn't reach the FOR loop and I cannot understand why...
modMainfunctions is my module with the main functions of my program are stored, within it I declare all my necessary variables:
Dim dbname As String = ""
Dim dblocation As String = Application.StartupPath
Dim con As New ADODB.Connection
Dim cat As New ADOX.Catalog
Dim tbl As New ADOX.Table
Dim col As ADOX.Column
Dim view As ADOX.View
Dim key As ADOX.Key
Dim index As New ADOX.Index
Can anyone see where I am going wrong? I want to obtain the meta data about a database (Please do not answer with "you need to connect to..." etc because I have already a subroutine which deals with this and it's working fine, I don't think it is a connection issue)
Problem solved, rather than storing this procedure in a module I simply stored it in the active form, I am unsure if this is the "best practise" but so long as my code is working as expected I'm happy. I realised that the error was because I didn't spell the world "yes" correctly... It was looking for the word "yes" and I typed "Yes" clearly the significance of thoroughly reading your code can be learnt here!

Get SIP Address using VBScript

I am trying to get a user's SIP address so I can use a JavaScript object to check their presence in Office Communicator. Here is a script I found that is similar to what I am looking to do.
Option Explicit
DIM objConnection, objCommand
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"
Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection
Dim objOU, objUser, strUPN, strSIP, SIPLine
' Bind to the OU object.
Set objOU = GetObject("LDAP://chkenergy.net/DC=chkenergy,DC=net")
' Enumerate all users in the OU.
objOU.Filter = Array("user")
For Each objUser In objOU
' Skip computer objects.
If (objUser.Class = "user") Then
strUPN = objUser.userPrincipalName
strSIP = objUser.get("msRTCSIP-PrimaryUserAddress")
wscript.echo strSIP
End If
Next
Basically, I can get their username from AD, and I would like to pass that in and get their SIP address (strSIP) back. Is there a way to fix this code to do that task specifically?
The problems of your posted vbscript are
It enumerates the user on the client side, which will take a lot of time to find the correct user. Similarly, instead of pulling all the records from the database and do the comparison on your client side, you would run a SQL query. Right?
The enumeration is done at one single level only. You have to fix your code to do recursive enumeration. However, if you fix it to do recursive enumeration, it's going to take even longer time and even more resources to do your job.
Before I answer your question, here are some basic background knowlege on Active Directory.
User objects on Active Directory contains a number of attributes.
In particular, samAccountName is your pre-Windows 2000 name.
userPrincipalName is in the format of user#domain.name
You can actully execute a query using an ADO connection object. Since you are binded to an Active Directory, you can execute a LDAP query. The LDAP query string contains four parts.
Root path, where we start the search.
LDAP filter
Returned attributes
Search scope
The LDAP query string that you should use should be something like
<LDAP://chkenergy.net/DC=chkenergy,DC=net>;(&(objectClass=user)(samAccountName=yourusername));msRTCSIP-PrimaryUserAddress;subtree
The root path in the above example is <LDAP://chkenergy.net/DC=chkenergy,DC=net>.
The LDAP filter is (&(objectClass=user)(samAccountName=yourusername)). Of course, you need to replace yourusername to something else inside your code. I am assuming you can pass in a samAccountName. If that's not the case, you need to modify the filter yourself.
Returned attributes is msRTCSIP-PrimaryUserAddress. I think that's what you need. Right?
I am assuming you are trying to search for all user objects under the same domain. So, your search scope should be subtree
Here is a complete sample that I guess it should do your job
userName = "harvey"
ldapStr = "<LDAP://chkenergy.net/DC=chkenergy,DC=net>;(&(objectClass=user)(samAccountName=" & userName & "));msRTCSIP-PrimaryUserAddress;subtree"
Set conn = CreateObject("ADODB.Connection")
conn.Provider = "ADSDSOObject"
conn.Open "ADs Provider"
Set rs = conn.Execute(ldapStr)
While Not rs.EOF
wscript.echo rs.Fields("msRTCSIP-PrimaryUserAddress")
rs.MoveNext
Wend

Resources