Closing a ADODB.Recordset VBA - ms-access-2010

I have built this VBA function but I'm getting the below error (see the next screenshot) in the below portion of the code:
Set RstUserAccess.ActiveConnection = Nothing
RstUserAccess.Close
Public Sub UserLogoutDetail(UserEmail As String)
Dim MySQL As String
Dim RstUserAccess As New ADODB.Recordset
Dim CmdUserAccess As New ADODB.Command
Dim i As Integer
'Setup the command
Set CmdUserAccess.ActiveConnection = fGetConn
CmdUserAccess.CommandType = adCmdText
MySQL = "UPDATE User_Access_TABLE SET EXIT_DATA = #" & Now & "# WHERE (((ID)=" & GetID_ToUpdate(UserEmail) & "))"
CmdUserAccess.CommandText = MySQL
RstUserAccess.CursorLocation = adUseClient
RstUserAccess.CursorType = adOpenDynamic
RstUserAccess.LockType = adLockOptimistic
'Open the connection
RstUserAccess.Open CmdUserAccess
Set RstUserAccess.ActiveConnection = Nothing
RstUserAccess.Close
'Cleanup
If CBool(CmdUserAccess.State And adStateOpen) = True Then
Set CmdUserAccess = Nothing
End If
If CBool(fGetConn.State And adStateOpen) = True Then
CloseConn
End If
End Sub
Error message
Do you have any suggestion?
Thanks
I have tried to change my code many times

Related

How to copy/paste a script from Excel/VBA to Rstudio

I´m trying to copy a R script from "Column 1" in Excel and paste it into Rstudio file "test2.R" and then run this code. I´m trying to do this using VBA. This is what I have now:
Public Sub RunRCode()
ActiveWorkbook.Save
Dim shell As Object
Set shell = VBA.CreateObject("WScript.Shell")
Dim waitTillComplete As Boolean: waitTillComplete = True
Dim style As Long: style = 1
Dim errorcode As Long
Dim path As String
Dim var1 As String
var1 = Worksheets("Planilha2").Columns(1).Copy
path = """C:\RWindows\R-3.5.1\bin\Rscript.exe"" ""C:\Users\j042409\Desktop\test2.R"" """ & var1 & """"
errorcode = shell.Run(path, style, waitTillComplete)
End Sub
this VBA code is able to open the cmd windows but it seems that it isn´t able to paste the code from "Column 1" into RStudio. Any thoughts?
Try the following code as per my comment:
Sub RunRCode()
Dim fso As Object, ts As Object, shell As Object
Dim Rng As Range, path As String, exepath As String, errorcode As Long
'Creating R file from Excel
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = CreateObject("Scripting.TextStream")
path = "Path to file\filename.R"
Set ts = fso.CreateTextFile(path, True)
For Each Rng In Worksheets("Planilha2").UsedRange.Columns(1).Rows
If Not IsEmpty(Rng.Value) Then ts.WriteLine Rng.Value
Next
ts.Close
'Running R script
Set shell = VBA.CreateObject("WScript.Shell")
exepath = "path to Rscript.exe"
errorcode = shell.Run(exepath & " " & path, 1, True)
If errorcode <> 0 Then MsgBox "Error code: " & errorcode, vbCritical
End Sub
I got it using this code below!
Public Sub RunRCode()
ActiveWorkbook.Save
Dim shell As Object: Set shell = VBA.CreateObject("WScript.Shell")
Dim errorcode As Long
Dim path As String: path = "C:\RWindows\R-3.5.1\bin\Rscript.exe " & saveTempScript
errorcode = shell.Run(path, 1, True)
Kill saveTempScript
End Sub
Public Function saveTempScript() As String
Dim filePath As String
Dim i As Integer
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(Planilha2.Name)
filePath = "C:\Users\" & VBA.Environ("USERNAME") & "\Desktop\test3.r"
Dim fso As FileSystemObject
Set fso = New FileSystemObject
Dim fileStream As TextStream
Set fileStream = fso.CreateTextFile(filePath)
For i = 1 To ws.Cells(ws.Cells.Rows.Count, "A").End(xlUp).Row
fileStream.WriteLine ws.Cells(i, 1).Value2
Next i
fileStream.Close
If Not fso.FileExists(filePath) Then
MsgBox "Arquivo não criado"
saveTempScript = vbNullString
GoTo try
Else
saveTempScript = filePath
End If
try:
Set fileStream = Nothing
Set fso = Nothing
End Function

Can't retrive image from mdb database this program show error "parameter in not valid"

Try
'connection string
Dim dbpath As String = System.IO.Path.GetDirectoryName(System.Reflection.Assembly.GetExecutingAssembly().CodeBase)
dbpath = New Uri(dbpath).LocalPath
Dim my_connection As String = "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=D:\DataBase\KhandagramPS.mdb"
Dim userTables As DataTable = Nothing
Dim connection As System.Data.OleDb.OleDbConnection = New System.Data.OleDb.OleDbConnection()
Dim DR As OleDbDataReader
'Dim source As String
'query string
Dim my_query As String = "SELECT sl_no,f_name,dob,sex,add,reg,[class],a_date,a_per,r_a_per,f_status,[name],photo,document FROM " & TextBox2.Text & " where sl_no=" & TextBox3.Text & " ;"
'create a connection
Dim my_dbConnection As New OleDbConnection(my_connection)
my_dbConnection.Open()
'create a command
Dim my_Command As New OleDbCommand(my_query, my_dbConnection)
DR = my_Command.ExecuteReader()
While (DR.Read())
txtslno.Text = (DR(0).ToString())
txtfname.Text = (DR(1).ToString())
Date1.Text = (DR(2).ToString())
comsex.Text = (DR(3).ToString())
txtadd.Text = (DR(4).ToString())
txtreg.Text = (DR(5).ToString())
comclass.Text = (DR(6).ToString())
Date2.Text = (DR(7).ToString())
txtaper.Text = (DR(8).ToString())
txtraper.Text = (DR(9).ToString())
txtfstatus.Text = (DR(10).ToString())
txtname.Text = (DR(11).ToString())
Dim ImageBuffer = CType(DR(12), Byte())
Dim imgStrm As New MemoryStream(ImageBuffer, True)
imgStrm.Write(ImageBuffer, 0, ImageBuffer.Length)
Dim img As Image = Image.FromStream(imgStrm)
PictureBox1.Image = img
End While
'close connection
my_dbConnection.Close()
Catch ex As Exception
MsgBox(ex.Message)
End Try
I suspect some error in your Byte-Array to Image conversion. Make sure that your Byte-Array is not messed up. Use this function instead.
Private Function getImage(imageBuffer as Byte())
Using ms as new IO.MemoryStream(imageBuffer)
Dim img = ImageIO.FromStream(ms)
Return img
End Using
End Function
my 2 cents: you shouldn't store images in an mdb file (unless things have changed a lot in the past few years). store images in a separate directory and store the file paths in the mdb so the image can be found when needed.

Activation Email/Link Not Working

I'm trying to send an activation email and have the user activate their account by clicking on the link provided. I have been tweaking it based on open source code I've been looking at online, however it has recently stopped sending the email without giving any errors. Here is the sign up form with the send email function:
Imports System.Data.SqlClient
Imports System.Data.Sql
Imports System.Data.SqlTypes
Imports System.Data
Imports System.Configuration
Imports System.Net.Mail
Imports System.Net
Imports System.Web
Imports System.Web.UI
Imports System.Web.UI.WebControls
Imports System.Web.UI.WebControls.WebParts
Imports System.Web.UI.HtmlControls
Public Class WebForm1
Inherits System.Web.UI.Page
Dim boolCar As Object
Private Sub btnSubmit_Click(sender As Object, e As EventArgs) Handles btnSubmit.Click
If txtEmailAddress.Text.Trim.EndsWith("#umary.edu") Or txtPassword.Text.Trim = txtRetypePassword.Text.Trim Then
Dim con As New SqlConnection
Dim cmdEmail As New SqlCommand
Dim cmdRegistration As New SqlCommand
Dim EmailCount As Integer = 0
Try
con.ConnectionString = "Data Source=SERVERNAME;Initial Catalog=StudentGov;User ID=sa;Password=Password1"
con.Open()
cmdEmail = New SqlCommand("SELECT COUNT(UMaryEmail) As EmailCount FROM RegisteredUsers WHERE UMaryEmail='" & txtEmailAddress.Text.Trim & "'", con)
EmailCount = cmdEmail.ExecuteScalar()
If EmailCount = 0 Then
' Declare database input variables
Dim userId As Integer = 0
Dim firstName As String = txtFirstName.Text
Dim lastName As String = txtLastName.Text
Dim hometown1 As String = txtHometown1.Text
Dim state1 As String = txtState1.Text
Dim zip1 As String = txtZipCode1.Text
Dim hometown2 As String = txtHometown2.Text
Dim state2 As String = txtState2.Text
Dim zip2 As String = txtZipCode2.Text
Dim phoneNum As String = txtPhoneNumber.Text
Dim emailAddress As String = txtEmailAddress.Text
Dim password As String = txtPassword.Text
Dim boolCar As Boolean = False
Dim boolUmary As Boolean = False
If radYesNo.SelectedIndex = 0 Then
boolCar = True
Else
boolCar = False
End If
' Define the command using parameterized query
cmdRegistration = New SqlCommand("INSERT INTO RegisteredUsers(FirstName, LastName, Hometown1, State1, ZIP1, Hometown2, State2, ZIP2, PhoneNum, UMaryEmail, Password, Car) VALUES (#txtFirstName, #txtLastName, #txtHometown1, #txtState1, #txtZipCode1, #txtHometown2, #txtState2, #txtZipCode2, #txtPhoneNumber, #txtEmailAddress, #txtPassword, #RadYesNo)", con)
' Define the SQL parameter '
cmdRegistration.Parameters.AddWithValue("#txtFirstName", txtFirstName.Text)
cmdRegistration.Parameters.AddWithValue("#txtLastName", txtLastName.Text)
cmdRegistration.Parameters.AddWithValue("#txtHometown1", txtHometown1.Text)
cmdRegistration.Parameters.AddWithValue("#txtState1", txtState1.Text)
cmdRegistration.Parameters.AddWithValue("#txtZipCode1", txtZipCode1.Text)
cmdRegistration.Parameters.AddWithValue("#txtHometown2", txtHometown2.Text)
cmdRegistration.Parameters.AddWithValue("#txtState2", txtState2.Text)
cmdRegistration.Parameters.AddWithValue("#txtZipCode2", txtZipCode2.Text)
cmdRegistration.Parameters.AddWithValue("#txtPhoneNumber", txtPhoneNumber.Text)
cmdRegistration.Parameters.AddWithValue("#txtEmailAddress", txtEmailAddress.Text)
cmdRegistration.Parameters.AddWithValue("#txtPassword", txtPassword.Text)
cmdRegistration.Parameters.AddWithValue("#RadYesNo", boolCar)
cmdRegistration.ExecuteNonQuery()
SendActivationEmail(userId)
Response.Redirect("RegistrationSuccess.aspx")
Else
' Duplicate Email Exist Error Message
MsgBox("Email address already supplied.")
End If
' Catch ex As Exception (Not needed)
' Error Executing One Of The SQL Statements
Finally
con.close()
End Try
Else
' Throw Error Message
MsgBox("Email input error")
End If
End Sub
Private Sub SendActivationEmail(userId As Integer)
Dim sqlString As String = "Server=SERVERNAME;Database=StudentGov;UId=sa;Password=Password1;"
Dim ActivationCode As String = Guid.NewGuid().ToString()
Dim ActivationUrl As String = Server.HtmlEncode("http://localhost:63774/ActivateAccount.aspx?userId=" & FetchUserId(txtEmailAddress.ToString) & "&txtEmailAddress=" & txtEmailAddress.ToString & "&ActivationCode=" & ActivationCode.ToString)
Using con As New SqlConnection(sqlString)
Using sqlCmd As New SqlCommand("UPDATE RegisteredUsers SET UserId = '" + userId.ToString + "', ActivationCode = '" + ActivationCode.ToString + "' WHERE UMaryEmail='" + txtEmailAddress.Text + "';")
Using sda As New SqlDataAdapter()
sqlCmd.CommandType = CommandType.Text
sqlCmd.Parameters.AddWithValue("#UserId", userId)
sqlCmd.Parameters.AddWithValue("#ActivationCode", ActivationCode)
sqlCmd.Connection = con
con.Open()
sqlCmd.ExecuteNonQuery()
con.Close()
End Using
End Using
End Using
Using mm As New MailMessage("****#outlook.com", txtEmailAddress.Text)
mm.Subject = "Account Activation"
Dim body As String = "Hello " + txtFirstName.Text.Trim() + ","
body += "<br /><br />Please click the following link to activate your account"
body += "<br /><a href='" & ActivationUrl & "'>Click here to activate your account.</a>"
body += "<br /><br />Thanks"
mm.Body = body
mm.IsBodyHtml = True
Dim smtp As New SmtpClient()
smtp.Host = "smtp.live.com"
smtp.EnableSsl = True
Dim NetworkCred As New NetworkCredential("****#outlook.com", "****")
smtp.UseDefaultCredentials = True
smtp.Credentials = NetworkCred
smtp.Port = 587
Try
smtp.Send(mm)
Catch ex As Exception
MsgBox("Email was not sent")
End Try
End Using
End Sub
Private Function FetchUserId(emailAddress As String) As String
Dim cmd As New SqlCommand()
Dim con As New SqlConnection("Data Source=SERVERNAME;Initial Catalog=StudentGov;User ID=sa;Password=Password1")
cmd = New SqlCommand("SELECT UserId FROM RegisteredUsers WHERE UMaryEmail=#txtEmailAddress", con)
cmd.Parameters.AddWithValue("#txtEmailAddress", emailAddress)
If con.State = ConnectionState.Closed Then
con.Open()
End If
Dim userId As String = Convert.ToString(cmd.ExecuteScalar())
con.Close()
cmd.Dispose()
Return userId
End Function
End Class
And here is the AccountActivation page:
Imports System.Data
Imports System.Data.SqlClient
Imports System.Configuration
Public Class ActivateAccount
Inherits System.Web.UI.Page
Protected Sub Page_Load(sender As Object, e As System.EventArgs) Handles Me.Load
If Not Page.IsPostBack Then
ActivateMyAccount()
End If
End Sub
Private Sub ActivateMyAccount()
Dim con As New SqlConnection()
Dim cmd As New SqlCommand()
Try
con.ConnectionString = "Data Source=CISWEB\UMCISSQL2008;Initial Catalog=StudentGov;User ID=sa;Password=Password1"
If (Not String.IsNullOrEmpty(Request.QueryString("UserId"))) And (Not String.IsNullOrEmpty(Request.QueryString("UMaryEmail"))) Then
'approve account by setting Is_Approved to 1 i.e. True in the sql server table
cmd = New SqlCommand("UPDATE RegisteredUsers SET AccountActivated=1 WHERE UserId=#UserId AND UMaryEmail=#txtEmailAddress", con)
cmd.Parameters.AddWithValue("#UserId", Request.QueryString("UserId"))
cmd.Parameters.AddWithValue("#txtEmailAddress", Request.QueryString("UMaryEmail"))
If con.State = ConnectionState.Closed Then
con.Open()
End If
cmd.ExecuteNonQuery()
Response.Write("You account has been activated. You can <a href='SignIn.aspx'>Sign in</a> now! ")
End If
Catch ex As Exception
ScriptManager.RegisterStartupScript(Me, Me.[GetType](), "Message", "alert('Error occured : " & ex.Message.ToString() & "');", True)
Return
Finally
con.Close()
cmd.Dispose()
End Try
End Sub
End Class
As you may be able to tell already, I am flummoxed. With no error messages I'm receiving, I don't know why the SendActivationEmail function is no longer working. Someone help please! :(
Hi FlummoxedUser are you sure that have you checked your code as well ????
Take a look here :
Dim ActivationUrl As String = Server.HtmlEncode("http://localhost:63774/ActivateAccount.aspx?userId=" & FetchUserId(txtEmailAddress.ToString) & "&txtEmailAddress=" & txtEmailAddress.ToString & "&ActivationCode=" & ActivationCode.ToString)
I think is better use httputility.urlEncode/Decode for this stuff where it use it to filter only the result of each function or single variable.
Second one take care at your code above
this is in your page :
If (Not String.IsNullOrEmpty(Request.QueryString("UserId"))) And (Not String.IsNullOrEmpty(Request.QueryString("UMaryEmail")))
where have you found "UmaryEmail" key in your querystring parameters?????
Check it and you will solve your issue but check also in cmd and so on in activation page or you will make some issues :)
I hope it help you and if it solves your issue mark this as answer.
UPDATE :
> Dim ActivationUrl As String = Server.HtmlEncode("http://localhost:63774/ActivateAccount.aspx?userId=" & FetchUserId(txtEmailAddress.ToString) & "&txtEmailAddress=" & txtEmailAddress.ToString & "&ActivationCode=" & ActivationCode.ToString)
with this task you create yout activation link which will be something like
http://localhost:63774/ActivateAccount.aspx?userId=1&txtEmailAddress=email#pippo&ActivationCode=123456
Now what's append when click on that link server handle request and create a collection data which include all the keys within your querystring
In effect you can use request.QueryString to check/retrieve values from each keys. So you can use as you did request.Querystring("keyname") to get the value for that particular parameter BUT in your case you check for a key which are not passed into the link. Pay attention that you have setup only 3 keys which are
UserID
txtEmailAddress
ActivationCode
there's no "UMaryEmail" key in request query string
Also another important stuff NEVER PASS IN QUERY STRING DATABASE FIELD :) use fantasy name or shortname which not reflect database field
example :
UserID => uid
ActivatioCode = token,acd,cd or anything you want
txtEmailAddress= email, em or any other name
Now activation page issue when you try to check your value use an if statement where check for userid key and UMaryEmail where userid could be matched coz it exist in query string but UmaryEmail is not into the request.querystring you have not provided it so if fails and nothing has been shown in page.
Here your Activation Sub revisited with some comments to better understand :
Private Sub ActivateMyAccount()
'Checking you keys in querystring
If Request.QueryString.AllKeys.Contains("Userid") AndAlso Request.QueryString.AllKeys.Contains("txtEmailAddress") Then
'here we assume that keys exist and so we can proceed with rest
If (Not String.IsNullOrEmpty(Request.QueryString("UserId"))) And (Not String.IsNullOrEmpty(Request.QueryString("txtEmailAddress"))) Then
'no we can proceed to make other stuff
'Another stuff place you connection string within connection string section in webconfig in order to make a simple request like this one :
'classic example for create a connection with web config file
' Using con As New SqlConnection(ConfigurationManager.ConnectionStrings("yourconnectionstringname").ToString)
Using con As New SqlConnection("Data Source=CISWEB\UMCISSQL2008;Initial Catalog=StudentGov;User ID=sa;Password=Password1")
If con.State = ConnectionState.Closed Then con.Open()
Dim sqlQuery As String = "UPDATE RegisteredUsers SET AccountActivated=1 WHERE UserId=#UserId AND UMaryEmail=#txtEmailAddress"
Using cmd As New SqlCommand(sqlQuery, con)
Try
With cmd
.Parameters.AddWithValue("#UserId", Request.QueryString("UserId"))
.Parameters.AddWithValue("#txtEmailAddress", Request.QueryString("txtEmailAddress"))
.ExecuteNonQuery()
Response.Write("You account has been activated. You can <a href='SignIn.aspx'>Sign in</a> now! ")
End With
Catch ex As Exception
ScriptManager.RegisterStartupScript(Me, Me.[GetType](), "Message", "alert('We apologize but something is gone wrong;our techs are checking the issue.Best regards etc etc etc');", True)
End Try
End Using
End Using
Else
Response.Write("<h1>invalid activation links!!</h1>")
End If
Else
Response.Write("<h1>invalid activation links!!</h1>")
End If
End Sub
If your query is right it should work at first shot :)
Take a try and let me know and if it solve your issue please mark it as answer
UPDATE 2:
Your actual code is :
Dim ActivationUrl As String = Server.HtmlEncode("localhost:63774/ActivateAccount.aspx?userId=" & HttpUtility.UrlEncode(FetchUserId(txtEmailAddress.ToString)) & "&txtEmailAddress=" & HttpUtility.UrlEncode(txtEmailAddress.ToString) & "&ActivationCode=" & HttpUtility.UrlEncode(ActivationCode.ToString))
But is all wrong let me explain:
Declar your variable : Dim ActivationUrl as string it is ok
Then built url so :
="http://localhost:63774/ActivateAccount.aspx?userId=" & HttpUtility.UrlEncode(FetchUserId(txtEmailAddress.text.tostring)) & "&txtEmailAddress=" & HttpUtility.UrlEncode(txtEmailAddress.text.tostring) & "&ActivationCode=" & HttpUtility.UrlEncode(ActivationCode.ToString))
Where take a look to piece of code which is your : 'HttpUtility.UrlEncode(txtEmailAddress.ToString)' in this manner you are passing a value system type object which is a textbox to pass textbox value you need to access to its .Text property like txtEmailAddress .Text
Change as per my code above and it will work (if your procedure is right)
**UPDATE CODE 3 **
Change your code with this.§be carefull don't change anything copy and paste all ActivateMyAccount Sub and delete your old one
Private Sub ActivateMyAccount()
'Checking you keys in querystring
If Request.QueryString.AllKeys.Contains("userId") And Request.QueryString.AllKeys.Contains("txtEmailAddress") Then
'here we assume that keys exist and so we can proceed with rest
If (Not String.IsNullOrEmpty(Request.QueryString("userId"))) And (Not String.IsNullOrEmpty(Request.QueryString("txtEmailAddress"))) Then
'no we can proceed to make other stuff
'Another stuff place you connection string within connection string section in webconfig in order to make a simple request like this one :
'classic example for create a connection with web config file
' Using con As New SqlConnection(ConfigurationManager.ConnectionStrings("yourconnectionstringname").ToString)
Using con As New SqlConnection("Data Source=CISWEB\UMCISSQL2008;Initial Catalog=StudentGov;User ID=sa;Password=Password1")
If con.State = ConnectionState.Closed Then con.Open()
Dim sqlQuery As String = "UPDATE RegisteredUsers SET AccountActivated=1 WHERE UserId=#UserId AND UMaryEmail=#txtEmailAddress"
Using cmd As New SqlCommand(sqlQuery, con)
Try
With cmd
cmd.Parameters.AddWithValue("#UserId", Request.QueryString("userId"))
cmd.Parameters.AddWithValue("#txtEmailAddress", Request.QueryString("txtEmailAddress"))
cmd.ExecuteNonQuery()
Response.Write("You account has been activated. You can <a href='SignIn.aspx'>Sign in</a> now! ")
End With
Catch ex As Exception
ScriptManager.RegisterStartupScript(Me, Me.[GetType](), "Message", "alert('We apologize but something is gone wrong;our techs are checking the issue.Best regards etc etc etc');", True)
End Try
End Using
End Using
Else
Response.Write("<h1>invalid activation links!! bad query string</h1>")
End If
Else
Response.Write("<h1>invalid activation links!! bad not string</h1>")
End If
End Sub

I got a Object reference not set to an instance of an object

I got this error when I click on SAVE button inside the save button is
The error is
"Object reference not set to an instance of an object"
Protected Sub btnWizardFinish_Click(sender As Object, e As EventArgs)
If (rdoAprovalList.SelectedIndex = 1) Then
SaveConsideration(4)
Else
SaveConsideration(1)
End If
End Sub
and this is save sub that contain to save and update a value in DocumentStatusID field in Database
Private Sub SaveConsideration(ByVal DocumentStatusID As Integer)
Dim Conn As New SqlConnection(strConn)
Dim cmd As New SqlCommand
Try
If ((txtProducerID.Text.Trim.Length = 9)) Then
cmd.Connection = Conn
cmd.CommandType = CommandType.StoredProcedure
cmd.CommandText = "spConsiderationSaving"
cmd.Parameters.AddWithValue("#libDocumentID", txtProducerID.Text)
cmd.Parameters.AddWithValue("#ProducerComments", txtProducerComment.Text)
cmd.Parameters.AddWithValue("#DocumentStatusID", DocumentStatusID)
cmd.Parameters.AddWithValue("#ConProduceThai", chkConproduceThai.Checked)
cmd.Parameters.AddWithValue("#ConProducePolicy", chkConProducePolicy.Checked)
cmd.Parameters.AddWithValue("#ConProduceIP", chkConProduceIP.Checked)
cmd.Parameters.AddWithValue("#ConProduceDanger", chkConProduceDanger.Checked)
cmd.Parameters.AddWithValue("#ConProducePeople", chkConproducePeople.Checked)
cmd.Parameters.AddWithValue("#ConProduceManage", chkConProduceManage.Checked)
cmd.Parameters.AddWithValue("#ConProduceMade", chkConProduceMade.Checked)
Conn.Open()
Dim ResponseText As Integer = DirectCast(cmd.ExecuteScalar, Int32).ToString
If (ResponseText = 1) Then
lblResponseResult.Text = "<img src='../images/icons/message-boxes/confirmation.png' /> บันทึกลงฐานข้อมูลเรียบร้อยแล้ว"
If (DocumentStatusID = 3) Then 'Goto next step
AlertRedirects("redirect", pnlHint.ClientID, 3, "Verification.aspx")
Else
AlertBoxs("alert", pnlHint.ClientID, 2)
End If
End If
Else
Dim sb As New System.Text.StringBuilder()
sb.Append("<script type = 'text/javascript'>")
sb.Append("window.onload=function(){")
sb.Append("javascript:history.back();return false;")
sb.Append("};")
sb.Append("</script>")
ClientScript.RegisterClientScriptBlock(Me.GetType(), "back", sb.ToString())
End If
Catch ex As Exception
Response.Write("Error Save: " & ex.Message)
Finally
Conn.Close()
End Try
End Sub
I think it's a problem with reference to something
what is the error please specify that. the code which you posted in that is seems two syntax mistakes
Dim ResponseText As Integer = DirectCast(cmd.ExecuteScalar, Int32).ToString
If (ResponseText = 1)
you are assigning ResponseText a string value which is an integer
and second is if condition there should be double equals like If (ResponseText == 1) because it's not assignment single equals used for assignment

LDAP + ASP Classic + ADODB = 2147217865. (Using LDAP to talk to Active Directory in ASP Classic. Error:2147217865)

I need to use LDAP to authenticate users for an old ASP website.
I have been using the code found here.
It looks like this:
<%# LANGUAGE=VBSCRIPT %>
<%Option Explicit%>
<%
Function getADUserInfo(strUID)
on error resume next
strGeneralLookupError = false
strBase = "<LDAP://DC=[DOMAIN], DC=[DOMAIN EXETENTION]>"
strFilter = "(sAMAccountName=" & strUID & ")"
strAttributes = "cn, mail, company, givenName, sn, ADsPath, name, sAMAccountName, telephoneNumber"
'strAttributes = "cn, company, givenName, sn, ADsPath, name, sAMAccountName, telephoneNumber"
strScope = "subtree"
strFullCommand = strBase & ";" & strFilter & ";" & strAttributes & ";" & strScope
set rsADUserInfo = Server.CreateObject("ADODB.Recordset")
set rsADUserInfo = connAD.Execute(strFullCommand)
if err.number <> 0 then
strGeneralLookupError = true
end if
set getADUserInfo = rsADUserInfo
set rsADUserInfo = Nothing
End Function
Sub getUserData(p_strUserID)
on error resume next
set rsUserData = Server.CreateObject("ADODB.Recordset")
set rsUserData = getADUserInfo(p_strUserID)
if not rsUserData.EOF then
strUserGN = rsUserData("givenName")
strUserSN = rsUserData("sn")
strUserOU = rsUserData("company")
strUserEmail = rsUserData("mail")
strUserPhone = rsUserData("telephoneNumber")
else
strADLookupSuccess = false
end if
rsUserData.Close
set rsUserData = Nothing
End Sub
on error resume next
response.expires = 0
DIM connAD, rsUserData, rsADUserInfo
DIM strUserGN, strUserSN, strUserOU, strUserEmail, strUserPhone
DIM strBase, strFilter,strAttributes, strScope, strFullCommand
DIM strGeneralLookupError, strADLookupSuccess
DIM strUserID
strUserGN = "The user can not be found in the system."
strGeneralLookupError = false
strADLookupSuccess = true
set connAD = Server.CreateObject("ADODB.Connection")
connAD.Provider = "ADsDSOObject"
connAD.Properties("User ID") = "[DOMAIN]\[USERNAME]" ' ### remember to make sure this user has rights to access AD
connAD.Properties("Password") = "[PASSWORD]"
connAD.Properties("Encrypt Password") = true
connAD.Open
strUserID = "[USERNAME YOU WANT INFO FOR]"
call getUserData(strUserID)
connAD.Close
set connAD = Nothing
%>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=windows-1252">
<title>ASP Code to access AD with LDAP Page</title>
</head>
<body>
<%=strUserGN%>
<%=strUserSN%><br />
<%=strUserOU%><br />
<%=strUserEmail%><br />
<%=strUserPhone%><br />
</body>
</html>
I can pull back info using C# so I don't think it's the server that is causing the issue.
All I end up with is a 2147217865 error.
The AD server is Windows Server 2003.
The web server is IIS on XP Pro.
I have tried changing strFullCommand to:
Select cn From 'LDAP://SEVERPATH' where objectClass='user'" & " and objectcategory='person'
No dice there. Any ideas?
This works:
function AuthenticateUser(UserName, Password, Domain)
dim strUser
' assume failure
AuthenticateUser = false
strUser = UserName
strPassword = Password
strQuery = "SELECT cn FROM 'LDAP://" & Domain & "' WHERE objectClass='*' "
set oConn = server.CreateObject("ADODB.Connection")
oConn.Provider = "ADsDSOOBJECT"
oConn.Properties("User ID") = strUser
oConn.Properties("Password") = strPassword
oConn.Properties("Encrypt Password") = true
oConn.open "DS Query", strUser, strPassword
set cmd = server.CreateObject("ADODB.Command")
set cmd.ActiveConnection = oConn
cmd.CommandText = strQuery
on error resume next
set oRS = cmd.Execute
if oRS.bof or oRS.eof then
AuthenticateUser = false
else
AuthenticateUser = true
end if
set oRS = nothing
set oConn = nothing
end function
The first thing I'd do to debug this is get rid of those On Error Resume Next statements. They could be hiding a multitude of sins that you're not seeing properly reported.

Resources