I have a VB6 application in which I fetch some data from the database.
I am having a problem while closing the created session.
Looks like the session is being retained even after I set the session object to Nothing. Seems like it gets closed only when I close the application.
I am using the following query to check the session in the database.
SELECT * FROM v$session where terminal='VirtualMachineName';
Below is the code,
Dim pCounter As Long, strLoadSQL As String
Dim objCursor As OraDynaset
Dim tmpDBSessobj As OracleInProcServer.OraSession
Dim tmpDBClientobj As OracleInProcServer.OraDatabase
Dim objresetGI As GameInfo
On Error GoTo ErrorHandler
Set tmpDBSessobj = CreateObject("OracleInProcServer.XOraSession")
Set tmpDBClientobj = tmpDBSessobj.OpenDatabase(strDBServiceName, strDBUsernamePassword, ORADB_ORAMODE)
'set autocommit false ---
tmpDBClientobj.AutoCommit = False
'set params
Do Until tmpDBClientobj.Parameters.Count = 0
For pCounter = 0 To tmpDBClientobj.Parameters.Count - 1
tmpDBClientobj.Parameters.Remove pCounter
Next
Loop
'bind
tmpDBClientobj.Parameters.Add "ocursor", Nothing, ORAPARM_OUTPUT
tmpDBClientobj.Parameters(0).serverType = ORATYPE_CURSOR
'declare proc signature
strLoadSQL = "begin resetpackage.getresetID(:ocursor); end;"
'reset this game
tmpDBClientobj.ExecuteSQL (strLoadSQL)
Set objCursor = tmpDBClientobj.Parameters(0).Value
'load the list box
If objCursor.RecordCount > 0 Then
argscollection.Clear
objCursor.MoveFirst
Do Until objCursor.EOF
objresetGI.strGameNo = objCursor.fields(0).Value
objresetGI.strAction = objCursor.fields(1).Value
objresetGI.strProcessInd = objCursor.fields(2).Value
argscollection.Add objresetGI, objCursor.fields(0).Value
objCursor.MoveNext
Loop
End If
Set objCursor = Nothing
tmpDBClientobj.Close
Set tmpDBClientobj = Nothing
Set tmpDBSessobj = Nothing
Any help in this regard will be appreciated.
objCursor should give you the option to use close and not nothing - objCursor.Close
Related
I am trying to open automatically an excel document on a Mac OS X, but it doesn't work. My code is:
Sub Button81_Click()
Dim objWord
Dim objDoc
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Open("/Users/ricardo/Miniman/miniman_uti.docx")
objWord.Visible = True
End Sub
Will the path be wrong? For this path "/Users/ricardo/Miniman/miniman_uti.docx" it opens excel files. Why not word files?
Can someone please help me?
Does this work for you?
sub Test()
dim objdoc as object
with CreateObject("word.application")
set objdoc = .documents.open("path")
end with
end sub
Code to safely open a word doc from a file.
Handles the case where you already have word open.
Dim w As Object
' If word is already open get ahold of the running instance
' Otherwise create a new instance
On Error Resume Next
Set w = GetObject(, "Word.Application")
If w Is Nothing Then Set w = CreateObject("Word.Application")
On Error GoTo 0
' Close all open files and shutdown Word
' Loop through any open documents and close them
Do Until w.Documents.Count = 0
w.Documents(1).Close
Loop
w.Quit False
Set w = Nothing
' Now that all instances of word are closed, open the template
Dim wdApp As Object
Dim wdDoc As Object
Set wdApp = CreateObject("Word.application")
wdApp.Visible = True
wdApp.DisplayAlerts = False
Set wdDoc = wdApp.Documents.Open(Filename:="MYPATH")
I have the below For loop. As you can see, I am trying to close the specific file if it is open.
The below set-up asks me whether I want to save the file. How do I close it without saving the file?
I've tried setting DisplayAlerts to False as well as ObjDoc.close False
The error I am getting is 'Property Let procedure not defined and Property Get procedure did not return an object'
Sub MacroExample()
' Define local variables
Dim objVisio
Dim objDoc
Dim blnVisioCreated
' Initialize Vision application reference variable
Set objVisio = Nothing
' Assume Visio is already running, then try and get a reference to it
blnVisioCreated = False
On Error Resume Next
Set objVisio = GetObject(, "Visio.Application")
On Error GoTo 0
' If Visio was not running already load it and remember that we created it
If objVisio Is Nothing Then
Set objVisio = CreateObject("Visio.InvisibleApp")
blnVisioCreated = True
End If
' See if out drawing is already open, if so close it
For Each objDoc In objVisio.Documents
If objDoc.Name = "Drawing1.vsd" Then
'objVisio.DisplayAlerts = False
objDoc.alertrespons = 0
objDoc.Close False
Exit For
End If
Next
Thanks all!
I've used this line before the closing line
objVisio.AlertResponse = vbNo
objDoc.Close
This is my script which opens Excel files and takes info from some cells then inserts it in another Excel document. I have included the entire script but marked where I think the error is. I am really confused at why this isn't working as I am using the exact same method in another script that works perfectly.
updated code from answers, same problem remains.
I think it's being caused by the Find_Excel_Row.
I tried putting the script in the function in the loop so there was no problem with variables but I got the same error.
Dim FSO 'File system Object
Dim folderName 'Folder Name
Dim FullPath 'FullPath
Dim TFolder 'Target folder name
Dim TFile 'Target file name
Dim TFileC 'Target file count
Dim oExcel 'The Excel Object
Dim oBook1 'The Excel Spreadsheet object
Dim oBook2
Dim oSheet 'The Excel sheet object
Dim StrXLfile 'Excel file for recording results
Dim bXLReadOnly 'True if the Excel spreadsheet has opened read-only
Dim strSheet1 'The name of the first Excel sheet
Dim r, c 'row, column for spreadsheet
Dim bFilled 'True if Excel cell is not empty
Dim iRow1 'the row with lower number in Excel binary search
Dim iRow2 'the row with higher number in Excel binary search
Dim iNumpasses 'Number of times through the loop in Excel search
Dim Stock 'product stock levels
Dim ID 'product ID
Dim Target 'Target file
Dim Cx 'Counter
Dim Cxx 'Counter 2
Dim RR, WR 'Read and Write Row
Call Init
Sub Init
Set FSO = CreateObject("Scripting.FileSystemObject")
FullPath = FSO.GetAbsolutePathName(folderName)
Set oExcel = CreateObject("Excel.Application")
Target2 = CStr("D:\Extractor\Results\Data.xls")
Set oBook2 = oExcel.Workbooks.Open(Target2)
TFolder = InputBox ("Target folder")
TFile = InputBox ("Target file")
TFileC = InputBox ("Target file count")
Call Read_Write
End Sub
Sub Read_Write
RR = 6
PC = 25
For Cx = 1 to Cint(TFileC)
Target = CStr("D:\Extractor\Results\"& TFolder & "\"& TFile & Cx &".html")
For Cxx = 1 to PC
Call Find_Excel_Row
Set oBook1 = oExcel.Workbooks.Open(Target)
Set Stock = oExcel.Cells(RR,5)
Set ID = oExcel.Cells(RR,3)
MsgBox ( Cxx &"/25 " &" RR: "& RR & " ID: " & ID & " Stock: " & Stock )
oBook1.Close
MsgBox "Writing Table"
oExcel.Cells(r,4).value = Stock '<<< Area of issue
oExcel.Cells(r,2).value = ID '<<<
oBook2.Save
oBook2.Close
Cxx = Cxx + 1
RR = RR + 1
Next
Cx = Cx + 1
Next
MsgBox "End"
oExcel.Quit
End sub
Sub Find_Excel_Row
bfilled = False
iNumPasses = 0
c = 1
iRow1 = 2
iRow2 = 10000
Set oSheet = oBook2.Worksheets.Item("Sheet1")
'binary search between iRow1 and iRow2
Do While (((irow2 - irow1)>3) And (iNumPasses < 16))
'Set current row
r = Round(((iRow1 + iRow2) / 2),0)
'Find out if the current row is blank
If oSheet.Cells(r,c).Value = "" Then
iRow2 = r + 1
Else
iRow1 = r - 1
End If
iNumPasses = iNumPasses + 1
Loop
r = r + 1
'Step search beyond the point found above
While bFilled = False
If oSheet.Cells(r,c).Value = "" Then
bFilled = True
Else
r = r + 1
End If
Wend
oExcel.Workbooks.Close
End Sub
In addition to what #Ekkehard.Horner said, you can't use the Excel object after quitting, so you should be getting an error when trying to open Data.xls.
oExcel.Workbooks.Close
oExcel.Quit
'writes to Graph sheet
set oBook = oExcel.Workbooks.Open("D:\Extractor\Results\Data.xls")
' ^^^^^^ This should be giving you an error
'Writing Table
MsgBox "Writing Table"
oExcel.Cells(r,4).value = Stock <<< Error here
oExcel.Cells(r,2).value = ID <<<
In fact, you're closing the application at several points in your script. Don't do that. Create the Excel instance once, use this one instance throughout your entire script, and terminate it when your script ends.
Edit: This is what causes your issue:
Set Stock = oExcel.Cells(RR,5)
Set ID = oExcel.Cells(RR,3)
...
oBook1.Close
...
oExcel.Cells(r,4).value = Stock '<<< Area of issue
oExcel.Cells(r,2).value = ID '<<<
You assign Range objects (returned by the Cells property) to the variables Stock and ID, but then close the workbook with the data these objects reference.
Since you want to transfer values anyway, assign the value of the respective cells to the variables Stock and ID:
Stock = oExcel.Cells(RR,5).Value
ID = oExcel.Cells(RR,3).Value
Also, I'd recommend to avoid using the Cells property of the application object. Instead use the respective property of the actual worksheet containing the data so it becomes more obvious what you're referring to:
Stock = oBook1.Sheets(1).Cells(RR,5).Value
ID = oBook1.Sheets(1).Cells(RR,5).Value
After you fixed that you'll most likely run into the next issue with the following lines:
oBook2.Save
oBook2.Close
You're closing oBook2 inside a loop without exiting from the loop. That should raise an error in the next iteration (when you try to assign the next values to the already closed workbook). Move the above two statements outside the loop or, better yet, move them to the Init procedure (after the Call Read_Write statement). From a handling perspective it's best to close/discard objects in the same context in which they were created (if possible). Helps avoiding attempts to use objects before they were created or after they were destroyed.
To further optimize your script you could even avoid the intermediate variables Stock and ID and transfer the values directly:
oBook2.Sheets(1).Cells(r,4).value = oBook1.Sheets(1).Cells(RR,5).Value
oBook2.Sheets(1).Cells(r,2).value = oBook1.Sheets(1).Cells(RR,5).Value
Re-using the same loop control variable (count) in nested loops is illegal:
Option Explicit
Dim bad_loop_counter
For bad_loop_counter = 1 To 2
WScript.Echo "outer", bad_loop_counter
For bad_loop_counter = 1 To 2
WScript.Echo "inner", bad_loop_counter
Next
Next
output:
cscript 32246593.vbs
... 32246593.vbs(6, 26) Microsoft VBScript compilation error: Invalid 'for' loop control variable
So your code won't even compile.
So, I've been asked to update an old Classic ASP website. It did not use parameterized queries and there was very little input validation. To simplify things I wrote a helper function that opens a connection to the database, sets up a command object with any parameters, and creates a disconnected recordset [I think!?! :)] Here's the code:
Function GetDiscRS(DatabaseName, SqlCommandText, ParameterArray)
'Declare our variables
Dim discConn
Dim discCmd
Dim discRs
'Build connection string
Dim dbConnStr : dbConnStr = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & rootDbPath & "\" & DatabaseName & ".mdb;" & _
"Persist Security Info=False"
'Open a connection
Set discConn = Server.CreateObject("ADODB.Connection")
discConn.Open(dbConnStr)
'Create a command
Set discCmd = Server.CreateObject("ADODB.Command")
With discCmd
Set .ActiveConnection = discConn
.CommandType = adCmdText
.CommandText = SqlCommandText
'Attach parameters to the command
If IsArray(ParameterArray) Then
Dim cnt : cnt = 0
For Each sqlParam in ParameterArray
discCmd.Parameters(cnt).Value = sqlParam
cnt = cnt + 1
Next
End If
End With
'Create the Recordset object
Set discRs = Server.CreateObject("ADODB.Recordset")
With discRs
.CursorLocation = adUseClient ' Client cursor for disconnected set
.LockType = adLockBatchOptimistic
.CursorType = adOpenForwardOnly
.Open discCmd
Set .ActiveConnection = Nothing ' Disconnect!
End With
'Return the Recordset
Set GetDiscRS = discRS
'Cleanup
discConn.Close()
Set discConn = Nothing
discRS.Close() ' <=== Issue!!!
Set discRs = Nothing
Set discCmd = Nothing
End Function
My problem is that if I call discRS.Close() at the end of the function, then the recordset that is returned is not populated. This made me wonder if the recordset is indeed disconnected or not. If I comment that line out everything works properly. I also did some Response.Write() within the function using discRS values before and after setting ActiveConnection = Nothing and it properly returned the recordset values. So it seems to be isolated to discRS.Close().
I found an old article on 4guysfromrolla.com and it issues the recordset Close() in the function. I've seen the same thing on other sites. I'm not sure if that was a mistake, or if something has changed?
Note: I'm using IIS Express built into Visual Studio Express 2013
Disconnected recordset as far as I know refers to a recordset populated manually, not from database, e.g.used as multi dimensional array or kind of hash table.
So what you have is not a disconnected recordset since it's being populated from database, and by disposing its connection you just cause your code to not work properly.
Since you already have Set discConn = Nothing in the code you don't have to set it to nothing via the recordset or command objects, it's the same connection object.
To sum this all up, you should indeed get rid of tho following lines in your code:
Set .ActiveConnection = Nothing ' Disconnect!
discRS.Close() ' <=== Issue!!!
Set discRs = Nothing
Then to prevent memory leaks or database lock issues, you should close and dispose the recordset after actually using it in the code using the function e.g.
Dim oRS
Set oRS = GetDiscRS("mydatabase", "SELECT * FROM MyTable", Array())
Do Until oRS.EOF
'process current row...
oRS.MoveNext
Loop
oRS.Close ' <=== Close
Set oRS = Nothing ' <=== Dispose
To avoid all this hassle you can have the function return "real" disconnected recordset by copying all the data into newly created recordset. If relevant let me know and I'll come with some code.
In your function, you cannot close and clean up your recordset if you want it to be returned to the calling process.
You can clean up any connections and command objects, but in order for your recordset to be returned back populated, you simply do not close it or dispose of it.
Your code should end like this:
'Cleanup
discConn.Close()
Set discConn = Nothing
'discRS.Close()
'Set discRs = Nothing
'Set discCmd = Nothing
end function
In your code i can see:
Set .ActiveConnection = Nothing ' Disconnect!
So, this Recordset isn't already closed?
He is indeed using a disconnected recordset. I started using them in VB6. You set the connection = Nothing and you basically have a collection class with all the handy methods of a recordset (i.e. sort, find, filter, etc....). Plus, you only hold the connection for the time it takes to fetch the records, so back when Microsoft licensed their servers by the connection, this was a nice way to minimize how many userm were connected at any one time.
The recordset is completely functional, it's just not connected to the data source. You can reconnect it and then apply any changes that were made to it.
It was a long time ago, it seems that functionality has been removed.
You should use the CursorLocation = adUseClient. Then you can disconnect the recordset. I have created a function to add the parameters to command dictionary objects, and then return a disconnected recordset.
Function CmdToGetDisconnectedRS(strSQL, dictParamTypes, dictParamValues)
'Declare our variables
Dim objConn
Dim objRS
Dim Query, Command
Dim ParamTypesDictionary, ParamValuesDictionary
'Open a connection
Set objConn = Server.CreateObject("ADODB.Connection")
Set objRS = Server.CreateObject("ADODB.Recordset")
Set Command = Server.CreateObject("ADODB.Command")
Set ParamTypesDictionary = Server.CreateObject("Scripting.Dictionary")
Set ParamValuesDictionary = Server.CreateObject("Scripting.Dictionary")
Set ParamTypesDictionary = dictParamTypes
Set ParamValuesDictionary = dictParamValues
Query = strSQL
objConn.ConnectionString = strConn
objConn.Open
With Command
.CommandText = Query
.CommandType = adCmdText
.CommandTimeout = 15
Dim okey
For Each okey in ParamValuesDictionary.Keys
.Parameters.Append .CreateParameter(CStr(okey), ParamTypesDictionary.Item(okey) ,adParamInput,50,ParamValuesDictionary.Item(okey))
Next
.ActiveConnection = objConn
End With
objRS.CursorLocation = adUseClient
objRS.Open Command , ,adOpenStatic, adLockBatchOptimistic
'Disconnect the Recordset
Set objRS.ActiveConnection = Nothing
'Return the Recordset
Set CmdToGetDisconnectedRS = objRS
'Clean up...
objConn.Close
Set objConn = Nothing
Set objRS = Nothing
Set ParamTypesDictionary =Nothing
Set ParamValuesDictionary =Nothing
Set Command = Nothing
End Function
I am newbie in VBScript and I've come across with the following problem. I want get data from sql server db and to allow RecordCount properties. Next code get data but RecordCount is disabled. How can I enable this properties
Const DB_CONNECT_STRING = "Provider=SQLOLEDB.1;Data Source=BUG\SQLSERVER2005;Initial Catalog=test;user id ='sa';password='111111'"
Set myConn = CreateObject("ADODB.Connection")
Set myCommand = CreateObject("ADODB.Command" )
myConn.Open DB_CONNECT_STRING
Set myCommand.ActiveConnection = myConn
myCommand.CommandText = ("select * from klienci k where k.indeks = " & oferty(16))
Set klienci = myCommand.Execute
AFAIK you can't change the cursor type when using the Execute method of the Command object, and you can't change the cursor type after you retrieved the recordset. Something like this might work, though:
Const DB_CONNECT_STRING = "Provider=SQLOLEDB.1;Data Source=BUG\SQLSERVER2005;Initial Catalog=test;user id ='sa';password='111111'"
Set myConn = CreateObject("ADODB.Connection")
myConn.Open DB_CONNECT_STRING
query = "select * from klienci k where k.indeks = " & oferty(16)
Set klienci = CreateObject("ADODB.Recordset")
klienci.CursorLocation = 3 'adUseClient
klienci.CursorType = 3 'adOpenStatic
klienci.LockType = 1 'adLockReadOnly
klienci.Open query, myConn
I don't think this is a VBScript issue- I think it is an ADO issue.
I think you are using a default forward-only cursor which won't work with recordcount.
I think you should stick a cursortype=adOpenStatic in there but I'm having a little trouble determining if you are specifying a recordset object - klienci?
If so try
klienci.cursortype=adOpenStatic