How can I Detect an ADO Connection Error? [duplicate] - vbscript

When a SQL batch returns more than one message from e.g. print statements, then I can only retrieve the first one using the ADO connection's Errors collection. How do I get the rest of the messages?
If I run this script:
Option Explicit
Dim conn
Set conn = CreateObject("ADODB.Connection")
conn.Provider = "SQLOLEDB"
conn.ConnectionString = "Data Source=(local);Integrated Security=SSPI;Initial Catalog=Master"
conn.Open
conn.Execute("print 'Foo'" & vbCrLf & "print 'Bar'" & vbCrLf & "raiserror ('xyz', 10, 127)")
Dim error
For Each error in conn.Errors
MsgBox error.Description
Next
Then I only get "Foo" back, never "Bar" or "xyz".
Is there a way to get the remaining messages?

I figured it out on my own.
This works:
Option Explicit
Dim conn
Set conn = CreateObject("ADODB.Connection")
conn.Provider = "SQLOLEDB"
conn.ConnectionString = "Data Source=(local);Integrated Security=SSPI;Initial Catalog=Master"
conn.Open
Dim rs
Set rs = conn.Execute("print 'Foo'" & vbCrLf & "print 'Bar'" & vbCrLf & "raiserror ('xyz', 10, 127)")
Dim error
While not (rs is nothing)
For Each error in conn.Errors
MsgBox error.Description
Next
Set rs = rs.NextRecordSet
Wend

Related

How to solve intermittent login problems with Oracle and VBA's ADODB

My environment is Windows 10, Office 2019 - 64 bit an Oracle Client 19.3.
I've had Office Macro's access Oracle data for years. Recently the Oracle server was upgraded from release 11.g to 18.c. The Macro's work on most PC's, but on a few I have intermittent problems logging in to Oracle. I'm wondering if it's because Oracle now has the concept of a "Container". In Oracle's SQL Plus it's called a "Service Name".
If I execute the code below using the UserID of "System" I get logged in, but can't see the tables in the container I need (XEPDB1). If I login with a UserID and Password that was created in the XEPDB1 container, I get an error telling me that I have an invalid UserID/Password combination.
Is there a way to use ADODB and specify a Container / Service Name as I log in so that I can avoid login errors?
Here's a snippet of the code that I'm using to login.
Option Explicit
Sub ReadFromOracle()
'DECLARE VARIABLES
Dim objConnection As ADODB.Connection
Dim objRecordset As ADODB.Recordset
Dim strConnection As String
Dim strSQL As String
Dim lngRecordCount As Long
On Error GoTo ErrorHandler
Set objConnection = New ADODB.Connection
Set objRecordset = New ADODB.Recordset
strConnection = "Provider=MSDASQL.1;" & _
"Persist Security Info=False;" & _
"Data Source=MyServer1;" & _
"UID=My_XEPDB1_UserID;" & _
"Password=My_XEPDB1_Password"
strConnection = "Provider=MSDASQL.1;" & _
"Persist Security Info=False;" & _
"Data Source=MyServer1;" & _
"UID=system;" & _
"Password=My_System_Password"
objConnection.ConnectionString = strConnection
'Open the database connection
objConnection.Open
strSQL = "Select title from LIB_BOOK where book_pk = 1;"
'Close objRecordset if it was open.
If CBool(objRecordset.State And adStateOpen) = True Then
objRecordset.Close
End If
objRecordset.CursorLocation = adUseClient
objRecordset.Open strSQL, objConnection
lngRecordCount = objRecordset.RecordCount
Exunt:
'Set objects to nothing
'Close objRecordSet
If CBool(objRecordset.State And adStateOpen) = True Then objRecordset.Close
Set objRecordset = Nothing
Set objConnection = Nothing
Exit Sub
ErrorHandler:
'Display the error message
'lngUpdateReturn = Err.Number
Select Case Err.Number
Case Is = -2147217843
MsgBox "Detailed Error Message for -2147217843.", vbCritical
Case Is = -2147467259
MsgBox "Detailed Error Message for -2147467259.", vbCritical
Case Else
MsgBox "Error Number : " & Err.Number & vbNewLine & vbNewLine & _
"Error Source: " & Err.Source & vbNewLine & vbNewLine & _
"Error Message : " & Err.Description & vbNewLine & vbNewLine, _
vbCritical
End Select
GoTo Exunt
End Sub
A subset of the TNSNAMES.ORA file is:
# tnsnames.ora Network Configuration File: C:\app\product\18.0.0\dbhomeXE\NETWORK\ADMIN\tnsnames.ora
# Generated by Oracle configuration tools.
MyServer1 =
(DESCRIPTION =
(ADDRESS =
(PROTOCOL = TCP)
(HOST = MyHost.MyDomain.com)
(PORT = 1521)
)
(CONNECT_DATA =
(SERVER = DEDICATED)
(SERVICE_NAME = XEPDB1)
)
)

Run-time Error 91: object variable or with block variable not set while linking VB6 and MS access

when i run the given original code the error in below line is shown "Run-time error 91"
con.Open "Provider=Microsoft.Jet.4.0;Data Source=C:\Documents and Settings\XPMUser\Desktop\New Folder\prac1.mdb; Persist Security Info = False"
original code
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Private Sub SUBMIT_Click()
con.Open "Provider=Microsoft.Jet.4.0;Data Source=C:\Documents and Settings\XPMUser\Desktop\New Folder\prac1.mdb; Persist Security Info = False"
rs.Open "select DBTB1 from prac1", con, adOpenDynamic, adLockPessimistic
rs.Fields("NUMBER").Value = Text1.Text
rs.Fields("NAME").Value = Text2.Text
rs.Fields("CITY").Value = Text3.Text
MsgBox "data saved!", vbInformation
rs.Update
End Sub
You are getting the Error 91 because you have not actually created the Connection object. Further, you will get the same error with the RecordSet. I have updated your code to allow it to work:
Private Sub SUBMIT_Click()
Set con = New ADODB.Connection
con.Open "Provider=Microsoft.Jet.4.0;Data Source=C:\Documents and Settings\XPMUser\Desktop\New Folder\prac1.mdb; Persist Security Info = False"
Set rs = New ADODB.Recordset
rs.Open "select DBTB1 from prac1", con, adOpenDynamic, adLockPessimistic
rs.AddNew
rs.fields("NUMBER").value = Text1.Text
rs.fields("NAME").value = Text2.Text
rs.fields("CITY").value = Text3.Text
rs.Update
MsgBox "data saved!", vbInformation
End Sub
Also, please note the addition of AddNew prior to updating the database.

VBScript code error when using ActiveX to get data from the database

Here is my code, I am trying to open a connection to our database and then using ActiveX to return all the data from column in a table and then outputting it to a text document. I'm getting this error.
PullData.vbs(41, 1) ADODB.Recordset: Item cannot be found in the
collection corresponding to the requested name or ordinal.
Here is my code, omitting sensitive information:
Const ForReading = 1
Dim sServer
Dim sLogin
Dim sPwd
Dim sDb
Dim oCn
Dim oRs
sServer = ""
sLogin = ""
sPwd = ""
sDb = ""
Set oCn = CreateObject( "ADODB.Connection" ) ' set oCn to create an object called ADODB.Connection
Set oRs = CreateObject( "ADODB.Recordset" ) ' set oRs to create an object called ADODB.Recordset
oCn.ConnectionString = "PROVIDER=SQLOLEDB" & _
";SERVER=" & sServer & _
";UID=" & sLogin & _
";PWD=" & sPwd & _
";DATABASE=" & sDb & " "
oCn.ConnectionTimeout=600
oCn.open 'Open the connection to the server
strSelString = "select CallID from dbo.CallLog" 'this is the SQL statement that runs a query on the DB
oRs.Open strSelString,oCn 'This opens the record set and has two parameters, strSelString and oCn
If oRs.EOF Then 'If open record set is at the end of file then...
wscript.echo "There are no records to retrieve; Check that you have the correct record number." 'echo that there is no records to retrieve.
End if
'if there are records then loop through the fields
Do While Not oRs.EOF ' Do while not open record set is not end of file
strfield = ors("Tracker")
if strfield <> "" then 'If strfield doesn't equal "" then
Set objFileSystem = WScript.CreateObject("Scripting.FileSystemObject") 'Set objFileSystem to create object Scripting.FileSystemObject
Set objOutPutFile = objFileSystem.CreateTextFile("c:\test.txt", True) 'Set objOutPutFile to create object objFileSystem.CreateTextFile
strcomputer = oRs 'strcomputer is set to read the line
wscript.echo strfield
objOutPutFile.WriteLine strfield &"|"
objFileSystem.close
objOutPutFile.close
end if
oRs.MoveNext
oCn.Close
Loop
You ask for the CallID column;
"select CallID from dbo.CallLog"
but then try to read something else:
strfield = ors("Tracker")
so either select Tracker or read CallID.
You could also probably create/open the file outside of the loop.

Syntax Error in From clause - VB6

Having a problem getting the above Error Message.
Can anyone assist please ?
Dim cn As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim RS As New ADODB.Recordset
Dim RS2 As New ADODB.Recordset
Set cn = New ADODB.Connection
Call cn.Open("Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & TheServer &
FileTypeOld & ";" & "Jet OLEDB:Database Password=12345678;")
If cn.State = 0 Then cn.Open
Set cmd.ActiveConnection = cn
cmd.CommandText = "SELECT * FROM mov"
cmd.CommandType = adCmdTable
Set RS = cmd.Execute
The problem is you are using an SQL statement with a Command type adCmdTable. When using that command type, ADO will generate the select query internally, you are expected in this case to just specify the name of the table.
Alternatively, just remove the cmd.CommandType = adCmdTable line all together and keep the select * syntax.
You need ton add this character _ which is underscore at the end of this line
Just replace with this:
Call cn.Open("Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & TheServer & _
FileTypeOld & ";" & "Jet OLEDB:Database Password=12345678;")
or you can merge both lines into one line without underscore, just like this
Call cn.Open("Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & TheServer & ileTypeOld & ";" & "Jet OLEDB:Database Password=12345678;")

vbscript, validate a user is in active directory by schema attribute

I'm trying to write a vb script that prompts a user for a schema attribute which I'll call bID and checks that the person with that bID is in active directory. I really have no idea how to get started, there are plenty of examples on how to query active directory users but I havent found a good one regarding checking against specific attributes. Any help/suggestions are greatly appreciated!
UPDATE:
ok heres my code so far, doesnt error out and returns 0, but I dont get a wscript.echo of the distinguished name for some reason. I included a few debugging wscript.echo's and it seems to never get into the while loop. Any ideas?
Option Explicit
GetUsers "CN=users,DC=example,DC=example,DC=example,DC=com","123456"
Function GetUsers(domainNc, ID)
Dim cnxn
Set cnxn = WScript.CreateObject("ADODB.Connection")
cnxn.Provider = "ADsDSOObject"
cnxn.Open "Active Directory Provider"
Dim cmd
Set cmd = WScript.CreateObject("ADODB.Command")
cmd.ActiveConnection = cnxn
cmd.CommandText = "<LDAP://" & domainNc & ">;(&(objectCategory=user)(objectClass=user) (employeeNumber=" & ID & "));distinguishedName;subtree"
WScript.Echo cmd.CommandText
cmd.Properties("Page Size") = 100
cmd.Properties("Timeout") = 30
cmd.Properties("Cache Results") = False
WScript.Echo "setting cmd.properties"
Dim rs
Set rs = cmd.Execute
WScript.Echo "rs object set"
While Not rs.eof
On Error Resume Next
WScript.Echo "while loop start"
Wscript.Echo rs.fields("distinguishedName".Value)
rs.MoveNext
If (Err.Number <> 0) Then
WScript.Echo vbCrLf& "Error # "& CStr(Err.Number)& " "& Err.Description
Else
On Error GoTo 0
End If
Wend
WScript.Echo "while loop end"
rs.close
WScript.Echo "rs object closed"
cnxn.Close
Set rs = Nothing
Set cmd = Nothing
Set cnxn = Nothing
End Function
Here's some vbscript that will find all users with bID=FooVal and write their DN out
Function GetUsers(domainNc, bIdVal)
Dim cnxn
Set cnxn = WScript.CreateObject("ADODB.Connection")
cnxn.Provider = "ADsDSOObject"
cnxn.Open "Active Directory Provider"
Dim cmd
Set cmd = WScript.CreateObject("ADODB.Command")
cmd.ActiveConnection = cnxn
cmd.CommandText = "<LDAP://" & domainNc & ">;(&(objectCass=user)(objectCategory=person)(bid=" & bidVal & "));distinguishedName;subtree"
cmd.Properties("Page Size") = 100
cmd.Properties("Timeout") = 30
cmd.Properties("Cache Results") = False
Dim rs
Set rs = cmd.Execute
While Not rs.eof
Wscript.Echo rs.fields("distinguishedName").Value
rs.MoveNext
Wend
rs.close
cnxn.Close
Set rs = Nothing
Set cmd = Nothing
Set cnxn = Nothing
End Function

Resources