Do I need to .Close Nested MSSQL Update Command in ASP Classic? - sql-server

Using Dreamweaver CS5 I have added the following Server Behaviour which is working fine.
Question is, do I need to .Close the MM_rsUser1?
The auto-generated code closes the MM_rsUser, but when I tried to close the MM_rsUser1 on the lines before or after where the MM_rsUser is closed, the page fails.
I found this reference for MySql that seems to indicate I may not 'need' to, but as this is my first project, I am trying to learn as many 'good habits' as possible...and since Dreamweaver is generating much of the VB code, I don't want to 'assume' what it does for me is necessarily the best practice today. (The project is adding dynamic data and editing said data to a pre-exising Classic ASP site...my next project will be upgrading it to MVC/C#)
<%
' *** Validate request to log in to this site.
MM_LoginAction = Request.ServerVariables("URL")
If Request.QueryString <> "" Then MM_LoginAction = MM_LoginAction + "?" + Server.HTMLEncode(Request.QueryString)
MM_valUsername = CStr(Request.Form("userid"))
If MM_valUsername <> "" Then
Dim MM_fldUserAuthorization
Dim MM_redirectLoginSuccess
Dim MM_redirectLoginFailed
Dim MM_loginSQL
Dim MM_rsUser
Dim MM_rsUser_cmd
Dim MM_loginUpdate ' used to execute timestamp to log last successful login for user
Dim MM_rsUser1 ' also used to execute timestamp as above
MM_fldUserAuthorization = "accessLevel"
MM_redirectLoginSuccess = "/sql.asp"
MM_redirectLoginFailed = "/login.asp"
MM_loginSQL = "SELECT email, password"
If MM_fldUserAuthorization <> "" Then MM_loginSQL = MM_loginSQL & "," & MM_fldUserAuthorization
MM_loginSQL = MM_loginSQL & " FROM table WHERE userid = ? AND pword = ?"
Set MM_rsUser_cmd = Server.CreateObject ("ADODB.Command")
MM_rsUser_cmd.ActiveConnection = MM_SQL_STRING
MM_rsUser_cmd.CommandText = MM_loginSQL
MM_rsUser_cmd.Parameters.Append MM_rsUser_cmd.CreateParameter("param1", 202, 1, 50, MM_valUsername) ' adVarWChar
MM_rsUser_cmd.Parameters.Append MM_rsUser_cmd.CreateParameter("param2", 202, 1, 50, Request.Form("password")) ' adVarWChar
MM_rsUser_cmd.Prepared = true
Set MM_rsUser = MM_rsUser_cmd.Execute
If Not MM_rsUser.EOF Or Not MM_rsUser.BOF Then
' username and password match - this is a valid user
Session("MM_Username") = MM_valUsername
MM_loginUpdate = "UPDATE table SET lastLoggedIn = { fn NOW() } WHERE userid = '" & MM_valUsername & "'"
MM_rsUser_cmd.CommandText = MM_loginUpdate
Set MM_rsUser1 = MM_rsUser_cmd.Execute ' unsure if I have to write an MM_rsUser1.Close somewhere or not, but page fails where I've tried
If (MM_fldUserAuthorization <> "") Then
Session("MM_UserAuthorization") = CStr(MM_rsUser.Fields.Item(MM_fldUserAuthorization).Value)
Else
Session("MM_UserAuthorization") = ""
End If
if CStr(Request.QueryString("accessdenied")) <> "" And true Then
MM_redirectLoginSuccess = Request.QueryString("accessdenied")
End If
MM_rsUser.Close
Response.Redirect(MM_redirectLoginSuccess)
End If
MM_rsUser.Close
Response.Redirect(MM_redirectLoginFailed)
End If
%>

The code is a little tricky, at first look. I see 2 statements that close MM_rsUser. The Response.Redirect() acts like a return statement, so only one or the other will be executed, even though the IF block tends to make it look otherwise. I think the key for you is that you can't close MM_rsUser1 if you don't enter the IF block, because it never was opened. So I would suggest this:
If Not MM_rsUser.EOF Or Not MM_rsUser.BOF Then
' username and password match - this is a valid user
Session("MM_Username") = MM_valUsername
MM_loginUpdate = "UPDATE table SET lastLoggedIn = '" & NOW() & "' WHERE userid = '" & MM_valUsername & "'"
MM_rsUser_cmd.CommandText = MM_loginUpdate
Set MM_rsUser1 = MM_rsUser_cmd.Execute ' unsure if I have to write an MM_rsUser1.Close somewhere or not, but page fails where I've tried
If (MM_fldUserAuthorization <> "") Then
Session("MM_UserAuthorization") = CStr(MM_rsUser.Fields.Item(MM_fldUserAuthorization).Value)
Else
Session("MM_UserAuthorization") = ""
End If
if CStr(Request.QueryString("accessdenied")) <> "" And true Then
MM_redirectLoginSuccess = Request.QueryString("accessdenied")
End If
MM_rsUser1.Close 'close it here
MM_rsUser.Close
Response.Redirect(MM_redirectLoginSuccess)
End If 'Not MM_rsUser.EOF Or Not MM_rsUser.BOF
'not open, so don't close it
MM_rsUser.Close
Response.Redirect(MM_redirectLoginFailed)
End If 'MM_valUsername <> ""
Update
Reusing MM_rsUser_cmd is confusing at best, and could be a cause of some of the errors. Change
MM_rsUser_cmd.CommandText = MM_loginUpdate
Set MM_rsUser1 = MM_rsUser_cmd.Execute
to
Dim MM_rsUser_cmd1
Set MM_rsUser_cmd1 = Server.CreateObject ("ADODB.Command")
MM_rsUser_cmd1.ActiveConnection = MM_SQL_STRING
MM_rsUser_cmd1.CommandText = MM_loginUpdate
MM_rsUser_cmd1.Parameters.Append MM_rsUser_cmd1.CreateParameter("param1", 135, 1, -1, NOW()) ' adDBTimeStamp
MM_rsUser_cmd1.Parameters.Append MM_rsUser_cmd1.CreateParameter("param2", 202, 1, 50, MM_valUsername) ' adVarWChar
MM_rsUser_cmd1.Prepared = true
Set MM_rsUser1 = MM_rsUser_cmd1.Execute

Related

Open, refresh, remove connection and save as vbscript

Can anyone please help me to figure out what is wrong with below VBScripting and how should I correct it?
It meant to
Open excel -- works
Refresh all data -- works
Remove external connection -- Dont work
Save as new file without any external connection -- Dont work due to 3rd step otherwise it does
Solution:
Set oExcel = CreateObject("Excel.Application")
oExcel.Application.Visible = True
oExcel.DisplayAlerts = False
oExcel.AskToUpdateLinks = False
oExcel.AlertBeforeOverwriting = False
Set oWorkbook = oExcel.Workbooks.Open("file path.xlsx")
oWorkbook.RefreshAll
Do While oExcel.ActiveWorkbook.Connections.Count > 0
oExcel.ActiveWorkbook.Connections.Item(oExcel.ActiveWorkbook.Connections.Count).Delete
Loop
oExcel.Activeworkbook.SaveAs "NewFileName_"& _
MyDateFormat &".xlsx"
oExcel.Activeworkbook.Close
oExcel.Quit
WScript.Quit
Please, try the next way:
Dim oExcel, oWorkbook
Set oExcel = CreateObject("Excel.Application")
oExcel.Application.Visible = True
oExcel.DisplayAlerts = False
oExcel.AskToUpdateLinks = False
oExcel.AlertBeforeOverwriting = False
Set oWorkbook = oExcel.Workbooks.Open("file path.xlsx")
oWorkbook.RefreshAll
'new approach to also delete the named range from Name Manager
Dim strAddr, N
strAddr = Split(oWorkbook.Connections("connection name").Ranges(1).Address(,,,True), "]")(1)
oWorkbook.Connections("connection name").Delete
For Each N In oWorkbook.Names
If Replace(strAddr, "'", "") = Replace(Mid(N.RefersTo, 2), "'", "") Then
N.Delete
End If
Next
oWorkbook.SaveAs "NewFileName_" & MyDateFormat & ".xlsx"
oWorkbook.Close
oExcel.Quit

VBS with ADODB Recordset Returning "Could not find prepared statement with handle -1"

I've written a VB Script to go through a folder, extract a record number from the filenames inside, query the corresponding zone for those record numbers, and rename/move the files as appropriate.
First I make a recordset of the files inside (rsFiles), and I build a SQL String from those record numbers as an inlist to query the corresponding zones into a second recordset (rsZones). Then I move through rsZones and write the appropriate zone back to rsFiles.
My code works with a small number of files (I've tested and gotten reliable results up to 200) but I need to process several thousand at a time... If I throw too many files at it, I get error 80040E14 "Could not find prepared statement with handle -1." at the line that does rsZones.MoveFirst.
I think this means rsZones doesn't have any records, but shouldn't that mean rsZones.EOF would resolve to TRUE? Also, I have the ADODB Command timeout set at 0, so why am I not getting records on a larger inlist?
Code extract below. Any help/ideas would be appreciate. Thanks!!
Const sSourceDir = "C:\MyDir\"
Set re = New RegExp
re.Global = False
Set rsFiles = CreateObject("ADOR.Recordset")
rsFiles.Fields.Append "File", adVarChar, MaxCharacters
rsFiles.Fields.Append "Record_Number", adVarChar, 10
rsFiles.Fields.Append "Zone", adVarChar, 2
rsFiles.Open
re.Pattern = "(\d{1,})_\d{1,}_[IPG]\S*.pdf"
Set oFolder = oFSO.GetFolder(sSourceDir)
Set oFiles = oFolder.Files
If oFiles.Count > 0 Then
For each oFile in oFiles
Set reMatches = re.Execute(oFile.Name)
If reMatches.Count > 0 Then
sRecordNumber = reMatches(0).subMatches(0)
sInlist = sInlist & "'" & sRecordNumber & "',"
Else
sRecordNumber = ""
End If
rsFiles.AddNew
rsFiles("File") = oFile.Name
rsFiles("Record_Number") = sRecordNumber
Next
End If
If sInlist = "" Then
MsgBox "No files matching record number pattern"
wScript.Quit
End If
sInlist = Left(sInlist, Len(sInlist)-1)
Const sConn = "Provider=SQLOLEDB;SERVER=my\server;DATABASE=default_database;TRUSTED_CONNECTION=yes"
sSQL = "select tablea.record_number, tablea.zone from tablea where tablea.record_number in (" & sInlist & ")"
Set oConn = CreateObject("ADODB.Connection")
oConn.ConnectionTimeout = 0
oConn.Open sConn
Set cmd = CreateObject("ADODB.Command")
With cmd
.ActiveConnection = oConn
.CommandText = sSQL
.CommandType = 1 'adCmdText
.CommandTimeout = 0
.Prepared = True
End With
set rsZones = CreateObject("ADODB.Recordset")
Set rsZones = cmd.Execute
If Not rsZones.EOF Then
rsZones.MoveFirst 'ERROR IS HERE
Do until rsZones.EOF
rsFiles.Filter = 0
rsFiles.Filter = "record_number = '" & rsZones(0) & "'"
rsFiles.MoveFirst
Do Until rsFiles.EOF
rsFiles("Zone") = rsZones("Zone")
rsFiles.MoveNext
Loop
rsZones.MoveNext
Loop
End If
rsZones.Close

Excel VBA Call to SQL Stored Procedure Returning Bogus Connection Error

I am working on a script to loop through an excel sheet, pass parameters to an SQL Server procedure that takes three parms and generates records based on the parms. When I make the call, it actually does pass the parameters correctly, executes the procedure and writes the records, but then I get a runtime error "1004 The query did not run..."
I've found comments that state to change Background Query = False - check. Set NoCount On - check... still getting the error.
The SQL Server procedure does include a ReturnValue parm (1/0), which I am not passing, because it states "Too Many Parameters" when I try to do that. Is that possibly the problem? Not sure how to receive back a return value.
Here is my VBA Code:
Sub CallProc()
Dim ws As Worksheet
Worksheets("AllTags").Activate
Dim Parm1 As String
Dim Parm2 As String
Dim Parm3 As Integer
Dim RowIndex As Long
Dim ReturnValue As Integer
RowIndex = 2
Do While Sheets("AllTags").Cells(RowIndex, 2).Value <> ""
If Sheets("AllTags").Cells(RowIndex, 3).Value > 0 Then
ReturnValue = 0
Parm1 = Sheets("AllTags").Cells(RowIndex, 1).Value
Parm2 = Sheets("AllTags").Cells(RowIndex, 2).Value
Parm3 = Sheets("AllTags").Cells(RowIndex, 3).Value
With ActiveWorkbook.Connections("TagUpload").OLEDBConnection
' SET NOCOUNT ON; ** IT DOESN'T LIKE THIS
.BackgroundQuery = False
.CommandText = "EXECUTE DCSTransfer.dbo.InsertTags '" & Parm1 & "', '" &
Parm2 & "', " & Parm3
.CommandType = xlCmdSql
.Connection = Array( _
"OLEDB;Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security
Info=True;Initial Catalog=DCSTransfer;Data Source=bdata03;Use Proc" _
, _
"edure for Prepare=1;Auto Translate=True;Packet Size=4096;Workstation
ID=B-MIS-NWILSON1;Use Encryption for Data=False;Tag with co" _
, "lumn collation when possible=False;")
.RefreshOnFileOpen = False
.SavePassword = False
.SourceConnectionFile = ""
.SourceDataFile = ""
.ServerCredentialsMethod = xlCredentialsMethodIntegrated
ActiveWorkbook.Connections("TagUpload").Refresh
.BackgroundQuery = False
On Error Resume Next ' **** NEVER GETS THIS FAR ***
End With
End If
RowIndex = RowIndex + 1
Loop
End
End Sub
Here is the script generated when I manually call the procedure in SQL Server and enter the Parms:
USE [DCSTransfer]
GO
DECLARE #return_value int
EXEC #return_value = [dbo].[InsertTags]
#Badge = N'9046',
#StartTag = N'80996',
#Qty = 70
SELECT 'Return Value' = #return_value
GO
Any other suggestions?
Figured it out... after two+ entire days spent paining over this!
Changed the CommandText to match the stored procedure:
.CommandText = "Declare #return_Value int EXEC #return_Value = DCSTransfer.dbo.InsertTags '" & Parm1 & "', '" & Parm2 & "', " & Parm3 & "SELECT 'Return Value' = #return_value"

VBScript to Automate Outlook emails via Mail Merge

Im looking for a VBScript that will automatically send an email to each person on a list of contacts I have in an excel tabel using a mail merge.
Any help would be much appreciated and if you need more info just ask :)
Basically I have this code
Sub SendMessage(DisplayMsg As Boolean, Optional AttachmentPath)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
' Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add("Nancy Davolio")
objOutlookRecip.Type = olTo
' Set the Subject, Body, and Importance of the message.
.Subject = "This is an Automation test with Microsoft Outlook"
.Body = "This is the body of the message." &vbCrLf & vbCrLf
.Importance = olImportanceHigh 'High importance
' Resolve each Recipient's name.
For Each ObjOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next
' Should we display the message before sending?
If DisplayMsg Then
.Display
Else
.Save
.Send
End If
End With
Set objOutlook = Nothing
End Sub
But I need it to, instead of creating an email, it uses a mail merge, and the email is to be sent to everyone on a list stored in an excel sheet, problem is, I have no idea how to do this so any help would be great!
Thanks
This will send one email to each person listed in an excel file. For this example, the name is in column A, the email address is in column B and the subject is in column C. Create a template in the drafts folder and set the subject to "Template". In the template email, use {} around any field you want to replace with another. In this example, {name} is replaced with the name from column A. Insert the {image} tag where you want the image to go. I'm assuming you want the same image since it's a corporate logo, so you just define the path in the SendMessage Sub. This will add the image as an attachment, there is no easy way to get around that but it will be embedded into the body of the email.
set app = CreateObject("Excel.Application")
Set wb = app.Workbooks.Open ("H:\Book1.xls")
'skip header row. set to 1 if you
'don't have a header row
set sh = wb.Sheets("Sheet1")
row = 2
name = sh.Range("A" & row)
email = sh.Range("B" & row)
subject = sh.Range("C" & row)
'image = sh.Range("D" & row)
LastRow = sh.UsedRange.Rows.Count
For r = row to LastRow
If App.WorkSheetFunction.CountA(sh.Rows(r)) <> 0 Then
SendMessage email, name, subject, TRUE, _
NULL, "H:\Scripts\Batch\pic.png", 80,680
row = row + 1
name = sh.Range("A" & row)
email = sh.Range("B" & row)
subject = sh.Range("C" & row)
'image = sh.Range("D" & row)
End if
Next
wb.close
set wb = nothing
set app = nothing
Sub SendMessage(EmailAddress, DisplayName, Subject, DisplayMsg, AttachmentPath, ImagePath, ImageHeight, ImageWidth)
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
template = FindTemplate()
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(0)
With objOutlookMsg
' Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(EmailAddress)
objOutlookRecip.resolve
objOutlookRecip.Type = 1
' Set the Subject, Body, and Importance of the message.
.Subject = Subject
.bodyformat = 3
.Importance = 2 'High importance
body = Replace(template, "{name}", DisplayName)
if not isNull(ImagePath) then
if not ImagePath = "" then
.Attachments.add ImagePath
image = split(ImagePath,"\")(ubound(split(ImagePath,"\")))
body = Replace(body, "{image}", "<img src='cid:" & image & _
"'" & " height=" & ImageHeight &" width=" & ImageWidth & ">")
end if
else
body = Replace(body, "{image}", "")
end if
if not isNull(AttachMentPath) then
.Attachments.add AttachmentPath
end if
.HTMLBody = body
' Should we display the message before sending?
If DisplayMsg Then
.Display
Else
.Save
.Send
End If
End With
Set objOutlook = Nothing
End Sub
Function FindTemplate()
Set OL = GetObject("", "Outlook.Application")
set Drafts = OL.GetNamespace("MAPI").GetDefaultFolder(16)
Set oItems = Drafts.Items
For Each Draft In oItems
If Draft.subject = "Template" Then
FindTemplate = Draft.HTMLBody
Exit Function
End If
Next
End Function

Row handle referred to a deleted row or a row marked for deletion

We have an old site that is giving us an error. It uses VBScript and the DB is SQL Server 2005.
Here is the code:
set oNotes = server.CreateObject("SCRIPTING.DICTIONARY")
openSQL "SELECT * FROM v_client_notes WHERE contact_id = " &_
my_contactID & " ORDER BY client_notes_duedate ASC"
do while rs.eof = false
set temp = server.CreateObject("SCRIPTING.DICTIONARY")
load_rs temp, rs
set oNotes(trim(rs("client_notes_id"))) = temp
rs.movenext'error on this line
loop
Error:
Microsoft OLE DB Provider for SQL Server error '80040e23'
Row handle referred to a deleted row or a row marked for deletion.
This error does not happen all the time, just for record sets returned with certain contact_id's. Haven't been able to pinpoint the difference in the ones that work and the ones that don't.
As you can see the error happens on rs.movenext.
I have made sure that the table has a primary key (client_notes_id).
Thank you for your help!
EDIT
Here is the code for load_rs:
function load_rs(dict,Byref record)
for each thing_record in record.fields
dict(thing_record.name) = trim(thing_record.value)
next
end function
Here is the update script. This is on a separate page that I post to (kinda AJAX style):
If request("client_notes") <> "" then
client_notes_subject = request("client_notes_subject")
client_notes_postedby = session("user")
client_notes_duedate = request("client_notes_duedate")
if client_notes_duedate = "" then
client_notes_duedate = NULL
end if
client_notes_date_entered = request("client_notes_date_entered")
client_notes = request("client_notes")
if isnumeric(request("contactID")) then contact_id = request("contactID")
if clientnotes_id="" then clientnotes_id="0"
openSQL("SELECT * FROM client_notes WHERE client_notes_id=" & clientnotes_id)
if rs.EOF then
openSQL("SELECT newid()")
client_notes_guid = rs(0)
openSQL("select * from client_notes")
rs.addnew
else
client_notes_guid = rs("guid")
rs.update
end if
rs("contact_id") = contact_id
rs("client_notes_subject") = client_notes_subject
rs("client_notes_postedby") = session("user")
'if client_notes_duedate <> Null then
rs("client_notes_duedate") = client_notes_duedate
'end if
rs("client_notes_date_entered") = client_notes_date_entered
rs("client_notes") = client_notes
rs("guid")=client_notes_guid
rs.update
'if client_notes_duedate = Null then
' sqlSetNullnotes = "UPDATE client_notes SET client_notes_duedate = NULL WHERE client_notes_id=" & clientnotes_id
' opensql sqlSetNullnotes
'end if
next_due_date = request("next_due_date")
if next_due_date = "" then
next_due_date = NULL
end if
openSQL("SELECT * FROM " & MainContactsDB & " WHERE Contact_ID=" & contactID)
rs("Last_Contact_Date") = client_notes_date_entered
rs("Next_Contact_Date") = next_due_date
rs.update
end if
openSQL method:
Set rs = Server.CreateObject("ADODB.Recordset")
function openSQL(SQLrs)
if rs.state = 1 then rs.close
'response.write sqlRS
rs.Open SQLrs, conn, 3, 3
end function
You currently have this:
openSQL("SELECT * FROM " & MainContactsDB & " WHERE Contact_ID=" & contactID)
rs("Last_Contact_Date") = client_notes_date_entered
rs("Next_Contact_Date") = next_due_date
rs.update
Why is there no handling for rs.EOF? Perhaps this is where the code is dying?
Ok I was able to solve this.
I am running the query against a view which joins 2 tables.
The problem was that sometimes a note was submitted without the user id so the join from one table to the other didn't work cause user id was null. I modified my query to the following:
"SELECT * FROM v_client_notes WHERE contact_id = " & my_contactID & " AND user_id IS NOT NULL ORDER BY client_notes_duedate ASC"
Now the error doesn't come back, it just excludes the notes that aren't assigned to someone. So now on to fixing why the note wasn't assigned to someone.
Thanks!
Should have the primary key in a table on which you would like to take an action, after that not any issue to update that table

Resources