I'm making some changes to a program that was written by another developer, which uses an SSDB Grid.
I'm writing the code for the BeforeUpdate method.
On Error GoTo BeforeUpdate_Err
Dim ans%
ans% = MsgBox("These changes will be committed to the database. These changes cannot be undone. " & _
"Would you like to continue?", vbYesNo, "Confirm Changes")
If ans% = 7 Then
Grd_Collection.CancelUpdate
End If
Exit Sub
BeforeUpdate_Err:
MsgBox (Err.Description)
The only other code for the grid is the InitColumnProps method.
However, after hitting the Exit Sub line, I get an error message "Update Error".
I've searched the code for this being hard-coded but it isn't, so it's coming from the grid.
What is causing the error and how do I fix it?
Doesn't the BeforeUpdate method pass in an integer? (Cancel As Integer) or something?
Therefore, you should just be able to change your code (and tidy it up) to this:
On Error GoTo BeforeUpdate_Err
If MsgBox("These changes will be committed to the database. These changes cannot be undone. " & _
"Would you like to continue?", vbYesNo, "Confirm Changes") = vbNo Then
Cancel = 1
End If
Exit Sub
BeforeUpdate_Err:
MsgBox (Err.Description)
Related
This is driving my crazy. I get an error ("500 - Internal server error.") on my web page when returning from this sub. It executes just fine and does what it's supposed to do: add a record of a user (MemID) to the Chat table for an event (EventID) if it hasn't already been added. The first query is to find out if there's already a record. If not, the INSERT statement adds a record. The error occurs after the sub has run.
Sub NewView (EventID)
MemID=Session("MemID")
If MemID>0 then
Set cn5=Server.CreateObject("ADODB.connection")
cn5.open application("gbConnect")
SQL="SELECT Chat.MemID, Chat.EventID FROM Chat WHERE Chat.MemID=" & MemID & " AND Chat.EventID=" & EventID & ";"
cn5.cursorLocation=3
Set Rst=cn5.execute(SQL)
If Rst.recordcount = 0 then
Comment="is watching"
SQL="INSERT INTO Chat ( MemID, EventID, Comment ) SELECT " & MemID & "," & EventID & ", '" & Comment & "';"
cn5.execute(SQL)
Set cn5=nothing
End If
End If
End Sub
On the page:
NewView (EventID) 'Returning from this sub causes an error! "500 - Internal server error."
OK. I figured it out. I got a lesson in scope of variables. Setting the variable Rst (recordset) in the sub ruined the same variable on the main page. Now just have to wait for my hair to grow back.
I am completely new to VB6, and I need to print images on a page. I am having print options in 2 different places on the same page.
What I have tried:
I tried to write a common method to perform the print operation:
Private Sub mnuPrintImage_Click()
On Error GoTo mnuPrintImage_Click_Error
gobjRLItemImage.PrintImage imgItem
Exit Sub
mnuPrintImage_Click_Error:
ShowError "frmItem.mnuPrintImage_Click"
End Sub
I tried to use Me.PrintForm, but when I do so, I am getting a popup to save the complete page. However, I need to print the image directly and don't want to save it locally.
Public Sub PrintImage()
On Error GoTo PrintImageError
me.printform
Exit Sub
PrintImageError:
Select Case Err.Number
Case 440:
' Cancel button pressed; do nothing
Case Else
Err.Raise Err.Number
End Select
End Sub
I've got a simple program than scans data into a spreadsheet along with a timestamp, then you can either update the data by saving, or quit and exit and save.
The only issue I've been stuck on for a day or so is to work around the error handling of the case of the spreadsheet being already open. Id like to have something like this;
if file is open THEn msgbox("File is open, close file and start again")
WScript.Quit
Option Explicit
DIM oFs: Set oFs = CreateObject("Scripting.FileSystemObject")
DIM objExcel, strExcelPath, objSheet
DIM ib
DIM msg1
DIM msg2
strExcelPath = "c:\temp\Example.xls"
Set objExcel = CreateObject("Excel.Application")
objExcel.WorkBooks.Open strExcelPath
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
DO
ib=inputbox("SCAN NAME, SCAN LOTS"&vbCrLf&"TO UPDATE,SCAN ""UPDATE."""&vbCrLf&"TO EXIT, SCAN ""QUIT.""","Picklot Passout Database")
IF ib="" THEN
msg1=MsgBox("You must scan either a NAME or LOT NUMBER."&vbCrLf&"If you want to exit, scan QUIT."&vbCrLf&"Click OK to continue.",vbokonly,"Cannot Insert Blank Data")
ELSEIF ib= "QUIT" OR ib= "quit" THEN
objExcel.ActiveWorkbook.Save
objExcel.ActiveWorkbook.Close
objExcel.Application.Quit
set objExcel = Nothing
Set oFs = Nothing
ELSEIF ib="update" OR ib="UPDATE" THEN
objExcel.ActiveWorkbook.Save
msg2=MsgBox("Update Complete.",vbokonly,"Database Updated")
ELSE
objSheet.Range("A2").EntireRow.Insert
objSheet.Cells(2, 1).Value = ib
objSheet.Cells(2, 2).Value=(now)
END IF
LOOP WHILE NOT ib="quit" AND NOT ib="QUIT"
This may help point you in the right direction. Sorry for the rushed, lowercase syntax and unconventional indentations (do not follow my bad practice - keep yours! :D), I wrote it in notepad you see - but it has been tested successfully.
Anyhow, with reference to your code, I have restructured it in a bad manner, familiar to me, adding the functionality you specify. Essentially the task manager application list is checked for a running instance of the "example" Excel file (depending on what version of excel you're using the syntax will differ).
If found it will make it the active window (thereby preventing a read only duplicate instance initiating). If no instance is found it will open "example.xlsx", in this case using a relative path to the script itself. A subroutine is then called to do the business with the cells...
I have written it in such a way to try keep your specs as well as maintain the "OK" and "Cancel" buttons explicitly functional. Please feel free to tinker with this, you may need to address the path and instr lines differently. I hope it helps! All the best.
path=createobject("scripting.filesystemobject").getparentfoldername(wscript.scriptfullname)
excelpath=path&"\example.xlsx"
set objword=createobject("word.application")
set coltasks=objword.tasks
i=0
for each objtask in coltasks
name=lcase(objtask.name)
if instr(name, "microsoft excel - example") then
i=1
end if
next
if i=1 then
wscript.echo "An active instance of ""example.xlsx"" has been found"
set objexcel=getobject(excelpath)
call UPDATER
else
set objexcel=createobject("excel.application")
objexcel.workbooks.open(excelpath)
set objsheet=objexcel.activeworkbook.worksheets(1)
objexcel.visible=true
call UPDATER
end if
sub UPDATER
do
data=inputbox("Please enter data" &vbcrlf&vbcrlf& "To save data & continue, type ""update""" &vbcrlf& "To save data & exit, type ""quit""","Excel DB Updater")
if isempty(data) then
objexcel.activeworkbook.close
objexcel.application.quit
wscript.quit()
elseif lcase(data)="quit" then
objexcel.activeworkbook.save
objexcel.activeworkbook.close
objexcel.application.quit
quit=msgbox("DB Updating complete",vbokonly,"Excel DB Updater")
wscript.quit
elseif lcase(data)="update" then
objexcel.activeworkbook.save
update=msgbox("Data save complete, press OK to continue",vbokonly,"Excel DB Updater")
elseif len(data)<>0 then
objsheet.range("A1").entirerow.insert
objsheet.cells(1, 1).value=data
objsheet.cells(1, 2).value=(now)
add=msgbox("Data added, press OK to continue",vbokonly,"Excel DB Updater")
end if
loop while len(data)>=0 and not lcase(data)="quit"
end sub
I have a weird problem with QTP 11. The following piece of code worked so far, but suddenly stopped working and throws Object does not support this property or method.: 'objPage.Link' for the line with 'if link exist'
Set objBrowser = Browser("creationtime:=" & Desktop.ChildObjects(oDesc).Count - 1 & "")
Set objPage = objBrowser.Page("title:=.*")
If objPage.Link("class:=menu_link_tab_.*", "html id:=.*DesktopTab").Exist(3) Then
msgbox "ok"
End If
Can anyone tell me what is wrong and/or how to do it right?
EDIT: I solved this but still have no idea what happened. I just cut this part from QTP script and pasted it into Notepad and then copied it from Notepad to QTP. Everything works fine. I did not change anything... Any ideas what the hell happened are welcomed.
ANOTHER EDIT: The problem reappears randomly. With no changes to anything I can just run the test 10 times to have it fail randomly with the 'Object does not support this property or method' message
I have a startBrowser function where I set the objPage and objBrowser :
Function startBrowser(vURL)
Dim oDesc
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = True
IE.Navigate vURL
Window("hwnd:=" & IE.HWND).Maximize
Set oDesc = Description.Create
oDesc( "micclass" ).Value = "Browser"
If Desktop.ChildObjects(oDesc).Count > 0 Then
Set objBrowser = Browser("creationtime:=" & Desktop.ChildObjects(oDesc).Count - 1 & "")
End If
Set objPage = objBrowser.Page("title:=.*")
End Function
I have added lots of msgboxes with GetROProperty to verify whether the objects are ok. They seem to be.
Now my function to click the link looks like this :
Function clickMainMenuLink(vIdentifier)
Set objLink = objPage.Link("class:=menu_link_tab_.*", "html id:=.*" & vIdentifier, "index:=0")
If objLink.Exist(timeOut) Then
objLink.Click
Else
reporter.ReportEvent micFail, "Click the " & vIdentifier & " menu link", "Cannot find the " & vIdentifier & " menu link"
ExitTestIteration
End If
End Function
So at the moment my test just opens the browser and clicks a link as I try to debug the thing, but it still fails or passes randomly. The run error indicates line with 'Set objLink'. Any ideas for further debugging? I'm on QTP11 and IE8 if it matters.
From your error does not support this property or method: objPage.Link it would appear that the problem isn't with the .Exist part of line but the .Link part (you can verify this by separating the line into two lines and see which fails
set objLink = objPage.Link("class:=menu_link_tab_.*", "html id:=.*DesktopTab")
If objLink.Exist(3) Then
From your comment it seems that you're creating objPage in a different location from where you're using it, I suggest making sure that the object arrives OK.
Thanks Motti, your reasoning was right. The problem was with the objPage part. Despite the fact that I could read every property of objPage in a function QTP sometimes just did not see this objPage as a Page object. I guess it has something to do with not declaring type explicitly, but that's just a guess. As a dirty workaround I set up the objBrowser and objPage in every function now and it works 100%.
In Access 2007, I have a form to add a new contact to a table:
RecSet.AddNew
RecSet![Code_Personal] = Me.txtCodePersonal.Value
RecSet![FName] = Me.TxtFName.Value
RecSet![LName] = Me.txtLName.Value
RecSet![Tel Natel] = Me.txtNatTel.Value
RecSet![Tel Home] = Me.txtHomeTel.Value
RecSet![Email] = Me.txtEmail.Value
RecSet.Update
This has worked so far, and the contact has successfully been aded. But I'm having two problems:
I want to display a messagebox to tell the user the contact was successfully added
If the contact was not successfully added because
A contact with this name already exists
A different issue
Then display a message box "Contact already exists" or "error occured" respectively.
My idea of doing this is:
If recSet.Update = true Then
MsgBox "Paolo Bernasconi was successfully added"
Else if RecSet![FName] & RecSet![LName] 'already exist in table
MsgBox "Contact already exists"
Else
MsgBox "An unknown error occured"
I know this code is wrong, and obviously doesn't work, but it's just to give you an idea of what I'm trying to achieve. Thanks for all your help in advance.
Add an error handler to your procedure.
On Error GoTo ErrorHandler
Then display the "success" notice to user immediately after updating the recordset.
RecSet.Update
MsgBox RecSet![FName] & " " & RecSet![FName] & _
" was successfully added"
If the update attempt fails, flow control passes to the ErrorHandler section.
ErrorHandler:
MsgBox "Oops!"
Undoubtedly you want something more refined than an "Oops!" message. A slick approach is to use a Select Case block to customize the response based on error number.
Determine whether the contact exists already before attempting to add it.
strCriteria = "Fname = '" & RecSet![FName] & "' AND LName = '" & _
RecSet![LName] & "'"
Debug.Print strCriteria
If DCount("*", "YourTable", strCriteria) > 0 Then
' do not attempt to add it again
MsgBox "Contact already exists"
Else
RecSet.AddNew
' and so forth
End If
Check the Debug.Print output in case I made a mistake when building strCriteria.
The intention here is to avoid the duplication error condition ... by only attempting to add a contact which doesn't exist. So that error should not happen, and any other errors will be dealt with by the error handler.