What is wrong in this code:
Dim con As ADODB.Connection
Dim rec As ADODB.Recordset
Set con = New ADODB.Connection
Set rec = New ADODB.Recordset
Dim count As Integer
con.Open "Provider=MSDAORA.1;Password=****;User ID=system;Persist Security Info=False"
con.CursorLocation = adUseClient
rec.Open "select count(*) as c from login_hisab where username = " & Text1.Text & " and password = " & Text2.Text & "", con, adOpenDynamic, adLockOptimistic
count = rec.Fields("c")
If count = 0 Then
MsgBox "Invalid USERNAME or PASSWORD"
End If
You probably have to put your sql values inside single quotes:
where username = '" & Text1.Text & "' and password = '" & Text2.Text & "'"
Try using a parameterized query like this (air code). Means you don't have to worry about passwords containing ' or ", you don't have to worry about SQL Injection, etc.
dim cmd As ADODB.Command
Set cmd = New ADODB.Command
cmd.CommandType = adCmdText
cmd.CommandTimeout = 30
cmd.CommandText = "select count(*) as c from login_hisab where username = ? and password = ?"
cmd.Parameters.Append cmd.CreateParameter("userid", adVarChar, _
adParamInput, Len(Text1.Text), Text1.Text)
cmd.Parameters.Append cmd.CreateParameter("pwd", adVarChar, _
adParamInput, Len(Text2.Text), Text2.Text)
cmd.ActiveConnection = con
Set rec = cmd.Execute()
count = rec.Fields("c")
If count = 0 Then
MsgBox "Invalid USERNAME or PASSWORD"
End If
Related
I have a problem adding data oracle database,it's show me this message(" https://ufile.io/lzpuj ") Run-time ORA-00904:"EMPCODE": invalid identifier.
This is Cody:
Dim connEmp As ADODB.Connection
Dim rsEmp As ADODB.Recordset
Private Sub Command1_Click()
Set rsEmp = New ADODB.Recordset
rsEmp.Open "select * from tablebooks where empcode = '" & Text1.Text & "'",
connEmp, adOpenKeyset, adLockReadOnly, adCmdText
If rsEmp.RecordCount <> 0 Then
MsgBox " ! åÐÇ ÇáßÊÇÈ ãæÌæÏ ÈÇáÝÚá "
rsEmp.Close
Set rsEmp = Nothing
Exit Sub
Else
Set rsEmp = New ADODB.Recordset
rsEmp.Open "select * from tablebooks where empcode = '" & Text1.Text & "'",
connEmp, adOpenKeyset, adLockPessimistic, adCmdText
rsEmp.AddNew
rsEmp!Book_no = Val(Trim(Text1.Text))
rsEmp!Book_name = Trim(Text2.Text)
rsEmp!Author_name = Trim(Text10.Text)
rsEmp!Edition_no = Val(Trim(Text3.Text))
rsEmp!Publisher_place = Trim(Text11.Text)
rsEmp!Part_no = Val(Trim(Text5.Text))
rsEmp!Book_cost = Trim(Text6.Text)
rsEmp!Place_book = Trim(Text7.Text)
rsEmp!Note = Trim(Text9.Text)
rsEmp!Date_publishing = DTPicker1.Value
rsEmp!Subject = Trim(Combo4.Text)
rsEmp!State = Trim(Combo4.Text)
rsEmp.Update
connEmp.Execute "commit"
rsEmp.Close
Set rsEmp = Nothing
Label11.Visible = True
Label11 = " ! ÊãÊ ÇáÅÖÇÝÉ ÈäÌÇÍ "
End If
End Sub
First make sure empcode is exactly the right column name.
Then fix your code. You have two big issues:
It's crazy-vulnerable to Sql Injection attacks.
It tries to re-open the same command on the same connection in the ELSE block for no reason.
The exact fix for #1 depends on which provider you are using (Ole vs Odbc), but this link might help:
Call a parameterized Oracle query from ADODB in Classic ASP
For #2, this is somewhat better:
Dim connEmp As ADODB.Connection
Dim rsEmp As ADODB.Recordset
Private Sub Command1_Click()
Set rsEmp = New ADODB.Recordset
'TODO: Use parameterized query here!
rsEmp.Open "select * from tablebooks where empcode = #empcode '" & Text1.Text & "'",
connEmp, adOpenKeyset, adLockReadOnly, adCmdText
If rsEmp.RecordCount <> 0 Then
MsgBox " ! åÐÇ ÇáßÊÇÈ ãæÌæÏ ÈÇáÝÚá "
rsEmp.Close
Set rsEmp = Nothing
Exit Sub
End If
rsEmp.AddNew
rsEmp!Book_no = Val(Trim(Text1.Text))
rsEmp!Book_name = Trim(Text2.Text)
rsEmp!Author_name = Trim(Text10.Text)
rsEmp!Edition_no = Val(Trim(Text3.Text))
rsEmp!Publisher_place = Trim(Text11.Text)
rsEmp!Part_no = Val(Trim(Text5.Text))
rsEmp!Book_cost = Trim(Text6.Text)
rsEmp!Place_book = Trim(Text7.Text)
rsEmp!Note = Trim(Text9.Text)
rsEmp!Date_publishing = DTPicker1.Value
rsEmp!Subject = Trim(Combo4.Text)
rsEmp!State = Trim(Combo4.Text)
rsEmp.Update
connEmp.Execute "commit"
rsEmp.Close
Set rsEmp = Nothing
Label11.Visible = True
Label11 = " ! ÊãÊ ÇáÅÖÇÝÉ ÈäÌÇÍ "
End Sub
I have a problem with calling my functions on Oracle server via VBA.
When I try calling function without parameters. It´s ok.
But, when I Calling functions with parameter. I get error ([Microsoft][ODBC driver for Oracle]Invalid parameter type)
Have any idea?
This is vba code and plsql (I make elementary function for test)
Vba
Private Sub test()
Dim Oracon As ADODB.Connection
Dim cmd As New ADODB.Command
Dim param1 As New ADODB.Parameter
Dim objErr As ADODB.Error
Set Oracon = CreateObject("ADODB.Connection")
mujuser = "xxxx"
mujPWD = "xxxxx"
strConn = "UID=" & mujuser & ";PWD=" & mujPWD & ";driver={Microsoft ODBC for Oracle};" & _
"SERVER=xx.xxx;"
Oracon.ConnectionString = strConn
Oracon.Open
cmd.ActiveConnection = Oracon
cmd.CommandText = "el_test"
cmd.CommandType = adCmdStoredProc
Set param1 = cmd.CreateParameter("P1", adLongVarChar, adParamInput, 256)
cmd.Parameters.Append param1
cmd.Parameters(0).Value = "ahoj1"
cmd.Execute
End Sub
And function
CREATE OR REPLACE FUNCTION EL_TEST
(
P1 IN VARCHAR2
) RETURN VARCHAR2 AS
BEGIN
RETURN 'Ahoj';
END EL_TEST;
Thanky you.
Get function return value with OLEDB
I searched high and low for this but finally solved the problem myself.
My solution is in VBScript but I have represented it in the (untested) code below.
The trick is that the first parameter is the return value.
Private Sub test()
Dim Oracon As ADODB.Connection
Dim cmd As New ADODB.Command
Dim param1 As New ADODB.Parameter
Dim param0 As New ADODB.Parameter
Dim objErr As ADODB.Error
Set Oracon = CreateObject("ADODB.Connection")
mujuser = "xxxx"
mujPWD = "xxxxx"
strConn = "UID=" & mujuser & ";PWD=" & mujPWD & ";driver={Microsoft ODBC for Oracle};" & _
"SERVER=xx.xxx;"
Oracon.ConnectionString = strConn
Oracon.Open
cmd.ActiveConnection = Oracon
cmd.CommandText = "el_test"
cmd.CommandType = adCmdStoredProc
Set param0 = cmd.CreateParameter("P0", adLongVarChar, adParamReturnValue, 256)
Set param1 = cmd.CreateParameter("P1", adLongVarChar, adParamInput, 256)
cmd.Parameters.Append param0
cmd.Parameters.Append param1
cmd.Execute
Dim result As String
result = param0.Value ' Use the variable you set. Same as cmd.Parameters(1).Value '
End Sub
I admit, I've never tried to execute a function like this through code, but I'm surprise this worked without the parameter because the way you have your function set up. I think the way you would want to get the value would be:
select el_test('ahoj1') from dual;
If you made this change from a function to a procedure, I think it will work the way you expect:
CREATE OR REPLACE procedure EL_TEST
( P1 IN VARCHAR2,
p2 out varchar2) is
BEGIN
p2 := 'Ahoj';
END EL_TEST;
And then your VBA would look like this:
Private Sub test()
Dim Oracon As ADODB.Connection
Dim cmd As New ADODB.Command
Dim param1 As New ADODB.Parameter
Dim objErr As ADODB.Error
Set Oracon = CreateObject("ADODB.Connection")
mujuser = "xxxx"
mujPWD = "xxxxxx"
strConn = "UID=" & mujuser & ";PWD=" & mujPWD & _
";driver={Microsoft ODBC for Oracle};SERVER=xxxx-xx"
Oracon.ConnectionString = strConn
Oracon.Open
cmd.ActiveConnection = Oracon
cmd.CommandText = "el_test"
cmd.CommandType = adCmdStoredProc
cmd.NamedParameters = True
cmd.Parameters.Append cmd.CreateParameter("P1", adVarChar, adParamInput, 256, "ahoj1")
cmd.Parameters.Append cmd.CreateParameter("P2", adVarChar, adParamOutput, 256)
cmd.Execute
Dim result As String
result = cmd.Parameters(1).Value
End Sub
I have a recordset rcdDNE. I want to update my reclamation by making some conditions with my existing recordset. But my table is not updating. Can you guys tell me where I am doing wrong?
Dim lngRecCount As Long
frmDNELoad.lblStatus.Caption = "Updating records in Reclamation Table..."
frmDNELoad.Refresh
CqDate = Format(Date, "dd/MM/yyyy")
Set rcdreclamation = New ADODB.Recordset
With rcdreclamation
.ActiveConnection = objConn
.Source = "SELECT * FROM T_DATA_reclamation"
.CursorType = adOpenDynamic
.CursorLocation = adUseClient
.LockType = adLockOptimistic
.Open
End With
rcdDNE.MoveFirst
Do Until rcdDNE.EOF
With cmdDNEFRC
.ActiveConnection = objConn
.CommandText = "update t_data_reclamation set ClaimStatus = 'C',DateClosed = 'CqDate', Audit_LastUpdated = 'CqDate', Audit_UserAdded = 'SYSTEM' where RTProvided = '" & rcdDNE("AccountNbr") & "'"
.CommandType = adCmdText
End With
rcdDNE.MoveNext
Loop
Unless its something you forgot to put in your sample code, You are missing a call to the Execute function inside your Command object's with block.
With cmdDNEFRC
.ActiveConnection = objConn
.CommandText = "update t_data_reclamation set ClaimStatus = 'C',DateClosed = 'CqDate', Audit_LastUpdated = 'CqDate', Audit_UserAdded = 'SYSTEM' where RTProvided = '" & rcdDNE("AccountNbr") & "'"
.CommandType = adCmdText
.Execute 'dont forget execution
End With
Also when writing data to the table, using Connection objects BeginTrans and CommitTrans function is recommended, just in case something has to go wrong when writing the data you don't end up with data inconsistencies.
When I am trying to execute the program I am getting an error like "operation is not allowed when the object is open".
I am geeting error in second part of the code where .Source = "SELECT * FROM t_data_Comments
Sub DneFroceClose()
Dim lngRecCount As Long
frmDNELoad.lblStatus.Caption = "Updating records in Reclamation and Comments Table..."
frmDNELoad.Refresh
CqDate = Format(Date, "dd/MM/yyyy")
Set rcdreclamation = New ADODB.Recordset
With rcdreclamation
.ActiveConnection = objConn
.Source = "SELECT * FROM T_DATA_reclamation"
.CursorType = adOpenDynamic
.CursorLocation = adUseClient
.LockType = adLockOptimistic
.Open
End With
rcdDNE.MoveFirst
rcdreclamation.MoveFirst
Do Until rcdDNE.EOF
Do Until rcdreclamation.EOF
If rcdDNE.Fields![AccountNbr] = rcdreclamation.Fields![RTProvided] Then
rcdreclamation.Fields![ClaimStatus] = "C"
rcdreclamation.Fields![DateClosed] = CqDate
rcdreclamation.Fields![Audit_LastUpdated] = CqDate
rcdreclamation.Fields![Audit_UserAdded] = "SYSTEM"
rcdreclamation.Update
Call DneComments
Exit Do
Else
rcdreclamation.MoveNext
End If
Loop
rcdDNE.MoveNext
rcdreclamation.MoveFirst
Loop
End Sub
Sub DneComments()
With cmdDNEFRC
.ActiveConnection = objConn
.CommandText = "insert into t_data_Comments (ControlNbr, Audit_DateAdded, Audit_UserAdded, Description, EntryType) values ('" & rcdreclamation("ControlNbr") & "', '" & rcdreclamation("DateClosed") & "', '" & rcdreclamation("Audit_UserAdded") & "', 'Claim force-closed.', 'FORCE-CLS')"
.CommandType = adCmdText
End With
Set rcdDneComments = New ADODB.Recordset
With rcddnefrc
.ActiveConnection = objConn
.Source = "SELECT * FROM t_data_Comments"
.CursorType = adOpenDynamic
.CursorLocation = adUseClient
.LockType = adLockOptimistic
.Open
End With
With rcddnefrc
.Requery
.AddNew
.Fields![ControlNbr] = rcdreclamation.Fields![ControlNbr]
.Fields![Audit_DateAdded] = rcdreclamation.Fields![DateClosed]
.Fields![Audit_UserAdded] = rcdDNE.Fields![Audit_UserAdded]
.Fields![Description] = "Claim force-closed."
.Fields![EntryType] = "FORCE-CLS"
.Update
End With
End Sub
Change the With line to
With rcdDneComments
I am trying to execute the query which stores recordset vales in sql db. when I am trying to execute that i am getting error like
the connection cannt be used to perform this operation. It may closed or not valid in this context error in vb6. Please help me to solve this issue.
' Write records to Database
frmDNELoad.lblStatus.Caption = "Loading data into database......"
Call FindServerConnection_NoMsg
Dim lngRecCount As Long
lngRecCount = 0
rcdDNE.MoveFirst
Set rcdReclamation = New ADODB.Recordset
With rcdReclamation
.ActiveConnection = objConn
.Source = "insert into t_DATA_DneFrc (RTN, AccountNbr, FirstName, MiddleName, LastName, Amount) values ('" & rcdDNE("RTN") & "', '" & rcdDNE("AccountNbr") & "', '" & rcdDNE("FirstName") & "', '" & rcdDNE("MiddleName") & "', '" & rcdDNE("LastName") & "', '" & rcdDNE("Amount") & "')"
.CursorType = adOpenDynamic
.CursorLocation = adUseClient
.LockType = adLockOptimistic
.Open cmdCommand
End With
Do Until rcdDNE.EOF
lngRecCount = lngRecCount + 1
frmDNELoad.lblStatus.Caption = "Adding record " & lngRecCount & " of " & rcdDNE.RecordCount & " to database."
frmDNELoad.Refresh
DoEvents
Call CommitNew
rcdDNE.MoveNext
Loop
frmDNELoad.lblStatus.Caption = "DNE Processing Complete."
frmDNELoad.Refresh
End Function
Sub CommitNew()
' Add records to DneFrc table
With rcdReclamation
.Requery
.AddNew
.Fields![RTN] = rcdDNE.Fields![RTN]
.Fields![AccountNbr] = rcdDNE.Fields![AccountNbr]
.Fields![FirstName] = rcdDNE.Fields![FirstName]
.Fields![MiddleName] = rcdDNE.Fields![MiddleName]
.Fields![LastName] = rcdDNE.Fields![LastName]
.Fields![Amount] = rcdDNE.Fields![Amount]
.Update
End With
End Sub
conection code
Sub InstantiateCommand_SQLText()
' Creates a command object to be used when executing SQL statements.
Set objCommSQLText = New ADODB.Command
objCommSQLText.ActiveConnection = objConn
objCommSQLText.CommandType = adCmdText
End Sub
Function FindServerConnection_NoMsg() As String
Dim rcdClientPaths As ADODB.Recordset
Dim strDBTemp As String
Const CLIENT_UPDATE_DIR = "\\PSGSPHX02\NORS\Rs\ClientUpdate\"
On Error Resume Next
' If persisted recordset is not there, try and copy one down from
' CLIENT_UPDATE_DIR. If that can't be found, create a blank one
' and ask the user for the server name.
Set rcdClientPaths = New ADODB.Recordset
' Does it already exist locally?
If FileExists_FullPath(App.Path & "\" & "t_PCD_ServerConnectionList.xml") = False Then
' Can it be retrieved from CLIENT_UPDATE_DIR
If Dir(CLIENT_UPDATE_DIR & "t_PCD_ServerConnectionList.xml") "" Then
FileCopy CLIENT_UPDATE_DIR & "t_PCD_ServerConnectionList.xml", App.Path & "\" & "t_PCD_ServerConnectionList.xml"
Else
' Creat a blank one.
With rcdClientPaths
.Fields.Append "ServerConnection", adVarChar, 250
.Fields.Append "Description", adVarChar, 50
.CursorType = adOpenDynamic
.LockType = adLockOptimistic
.CursorLocation = adUseClient
.Open
.Save App.Path & "\" & "t_PCD_ServerConnectionList.xml", adPersistXML
.Close
End With
End If
End If
' Open the recordset
With rcdClientPaths
.CursorType = adOpenDynamic
.LockType = adLockOptimistic
.CursorLocation = adUseClient
.Open App.Path & "\" & "t_PCD_ServerConnectionList.xml", , , , adCmdFile
End With
If rcdClientPaths.RecordCount 0 Then
' try each one listed
rcdClientPaths.MoveFirst
Do Until rcdClientPaths.EOF
strDBTemp = TryConnection_NoMsg(rcdClientPaths.Fields![serverconnection])
If strDBTemp "" Then
FindServerConnection_NoMsg = strDBTemp
Exit Function
End If
rcdClientPaths.MoveNext
Loop
strDBTemp = ""
End If
Do While strDBTemp = ""
If strDBTemp "" Then
strDBTemp = TryConnection_NoMsg(strDBTemp)
If strDBTemp "" Then
With rcdClientPaths
.AddNew
.Fields![serverconnection] = strDBTemp
.Update
.Save
End With
FindServerConnection_NoMsg = strDBTemp
Exit Function
End If
Else
Exit Function
End If
Loop
End Function
Function TryConnection_NoMsg(ByVal SvName As String) As String
On Error GoTo ErrHandle
' If a server was provided, try to open a connection to it.
Screen.MousePointer = vbHourglass
Set objConn = New ADODB.Connection
With objConn
.CommandTimeout = 30
.ConnectionTimeout = 30
.ConnectionString = "Provider=SQLOLEDB.1; Server=" & SvName & "; User ID=RS_Auth; Password=weLcomers_auth; Initial Catalog=NORS" ' Test
.Open
.Close
End With
Set objConn = Nothing
TryConnection_NoMsg = SvName
Screen.MousePointer = vbNormal
Exit Function
ErrHandle:
TryConnection_NoMsg = ""
Set objConn = Nothing
Screen.MousePointer = vbNormal
Exit Function
End Function
You have already closed the connection here in TryConnection_NoMsg function (?)
With objConn
.CommandTimeout = 30
.ConnectionTimeout = 30
.ConnectionString = "Provider=SQLOLEDB.1; Server=" & SvName & "; Database=NORS; User ID=RS_Auth; Password=weLcomers_auth; Initial Catalog=NORS" ' Test
.Open
.Close
I'd suspect that FindServerConnection_NoMsg is not managing to open the connection, and since it ends in NoMsg that you're not seeing the error about why the connection wasn't opened. You then go on to just use the connection without knowing that the open failed.
Post the code for FindServerConnection_NoMsg.
BTW, your question itself should have given you a clue. It specifically says that the connection can't be used, and that it may not be open. That should have told you where to start looking, and at the least told you you should have posted the code that opened the connection as part of your question.
Thanks for everyone. I sloved my problem. This what i cahnge in my code
Dim lngRecCount As Long
lngRecCount = 0
rcdDNE.MoveFirst
With cmdCommand
.ActiveConnection = objConn
.CommandText = "insert into t_DATA_DneFrc (RTN, AccountNbr, FirstName, MiddleName, LastName, Amount) values ('" & rcdDNE("RTN") & "', '" & rcdDNE("AccountNbr") & "', '" & rcdDNE("FirstName") & "', '" & rcdDNE("MiddleName") & "', '" & rcdDNE("LastName") & "', '" & rcdDNE("Amount") & "')"
.CommandType = adCmdText
End With
Set rcddnefrc = New ADODB.Recordset
With rcddnefrc
.ActiveConnection = objConn
.Source = "SELECT * FROM T_DATA_DNEFRC"
.CursorType = adOpenDynamic
.CursorLocation = adUseClient
.LockType = adLockOptimistic
.Open
End With
Do Until rcdDNE.EOF
lngRecCount = lngRecCount + 1
frmDNELoad.lblStatus.Caption = "Adding record " & lngRecCount & " of " & rcdDNE.RecordCount & " to database."
frmDNELoad.Refresh
DoEvents
Call CommitNew
rcdDNE.MoveNext
Loop
frmDNELoad.lblStatus.Caption = "DNE Processing Complete."
frmDNELoad.Refresh