I want to do a CallByName for some Subs but I just can't get it to go.
Everything goes fine until execution reaches the CallByName, then I have problems:
Whenever I use Me, it complains about a compile error
And if I use frmMyServer, it says "object or method not supported"
Question: How do I do this?
This is what I have :
in my 'modHandleData'
Private Sub HandleRequestScriptedNPC(...)
' ...
NPCMethod = "Scripted_Npc_" & NpcNum
CallByName Me, NPCMethod, VbMethod, NpcNum, Index
End Sub
in my 'modScriptedNPC'
Public Sub Scripted_Npc_9(ByVal NpcNum As Long, PlayerNum As Long)
SendOneOptionMsg PlayerNum, "NPC 9", "NPC 9 talks." & vbCrLf & "Then gives you a clue"
End Sub
You’re calling the code in a module, so there is no Me instance (that only exists in classes, including forms). My VB6 is a bit rusty, but I believe you cannot call methods in modules using CallByName since you need an object.
Related
I have found on this site code for VBS to block user input. To simplify, code is:
Sub StopKeyMouse()
Set Def_DLL = DLL.DefineDLL("USER32")
Def_Proc = Def_DLL.DefineProc("BlockInput", vt_b1, vt_b1)
Set Lib = DLL.Load("USER32.DLL", "USER32")
Lib.BlockInput(True)
End Sub
Sub ResumeKeyMouse()
Set Def_DLL = DLL.DefineDLL("USER32")
Def_Proc = Def_DLL.DefineProc("BlockInput", vt_b1, vt_b1)
Set Lib = DLL.Load("USER32.DLL", "USER32")
Lib.BlockInput(False)
End Sub
Sub Test()
StopKeyMouse()
WScript.Sleep 1000
ResumeKeyMouse()
End Sub
Test()
When I run it, I get the error Object required: 'DLL'. Since the post is from 2004, I assume that VBS interaction with User32.dll has been changed.
I am missing a line with CreateObject, something like Set DLL = CreateObject("User32.dll").
Does anybody know what is correct code for script to work?
I have also found that it was possible to use
Set oAutoIt = CreateObject("AutoItX.Control")
oAutoIt.BlockInput "on"
But this is obsolete.
Is it possible to call BlockInput from VBS?
Thank you for any help.
I want to pass the sourceform, from which I use the CallByName-function. Somehow, it doesn't work in way I post it down there.
Private Sub Command1_Click()
'CallByName Form1, "TestFkt", VbMethod, Nothing, Command1 '<--- works
CallByName Form1, "TestFkt", VbMethod, Me, Command1 '<--- Problem
End Sub
Public Function TestFkt(ParamArray myParams())
Dim oForm As Object
Set oForm = myParams(0)
' ...
End Function
The error reported from vb6 is runtime error 450: "Falsche Anzahl an Argumenten oder ungültige Zuweisung zu einer Eigenschaft". I think the first reason is not the problem, because the commented line above works. It seems more, that the problem has something to do with the keyword me.
Anybody some idea?
Its not CallByName:
TestFkt Form1, Me
Is also not valid as you cannot pass Me when using a ParamArray. This is a peculiarity of Me which is something of a special case.
Workaround:
Dim fMe As VB.Form: Set fMe = Me
CallByName Form1, "TestFkt", VbMethod, fMe, Command1
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%.
Greetings for the day,
Hi, I am a beginner using vb 6.0. I am using the following code and getting 'user defined type not defined'.the code is below.the line where i get error is highlighted.Kindly help.should i add some references or components?if so,what it would be. your timely and kindly help will be much more helpful for me
Public Sub LoadDocument()
Dim xDoc As MSXML2.DOMDocument
Set xDoc = New MSXML2.DOMDocument
xDoc.async = False
xDoc.validateOnParse = False
If xDoc.Load("C:\Users\284582\Desktop\XML1.xml") Then
DisplayNode xDoc.ChildNodes, 0
End If
End Sub
' Error on this line'
Public Sub DisplayNode(ByRef Nodes As MSXML.IXMLDOMNodeList, _
ByVal Indent As Integer)
Dim xNode As MSXML.IXMLDOMNode
Indent = Indent + 2
For Each xNode In Nodes
If xNode.NodeType = NODE_TEXT Then
Debug.Print Space$(Indent) & xNode.ParentNode.nodeName & _
":" & xNode.NodeValue
End If
If xNode.HasChildNodes Then
DisplayNode xNode.ChildNodes, Indent
End If
Next xNode
End sub
It's MSXML2.IXMLDOMNodeList, not MSXML.IXMLDOMNodeList.
The library may be missing from your references. Try this.
Manually adding MSXML2
1. Open MS Access.
2. Database Tools ribbon
3. Visual Basic ribbon item (icon)
4. Double-click on any module to open it.
5. Tools menu
6. References…
7. Find Microsoft XML, v6.0. is in the list
a. If in list but not checked, check it and click [OK].
b. If not in the list:
i. click [Browse…] and add "c:\windows\system32\msxml6.dll"
8. [OK] your way back to the Visual Basic window.
9. Close the Visual Basic Window. You should be good to go.
Programmatically adding MSXML2
Add the following sub and function. Run the sub. Edit the sub to include a path if necessary.
Check for broken references in the library
Adapted from Add references programatically
Sub CheckXmlLibrary()
' This refers to your VBA project.
Dim chkRef As Reference, RetVal As Integer ' A reference.
Dim foundWord As Boolean, foundExcel As Boolean, foundXml As Boolean
foundWord = False
foundExcel = False
foundXml = False
' Check through the selected references in the References dialog box.
For Each chkRef In References
' If the reference is broken, send the name to the Immediate Window.
If chkRef.IsBroken Then
Debug.Print chkRef.Name
End If
'copy and repeat the next 2 if statements as needed for additional libraries.
If InStr(UCase(chkRef.FullPath), UCase("msxml6.dll")) <> 0 Then
foundXml = True
End If
Next
If (foundXml = False) Then
'References.AddFromFile ("C:\Windows\System32\msxml6.dll") <-- For other than XML, modify this line and comment out line below.
RetVal = AddMsXmlLibrary
If RetVal = 0 Then MsgBox "Failed to load XML Library (msxml6.dll). XML upload/download will not work."
End If
End Sub
Add XML reference to the library
Developed by Chris Advena. Thanks to http://allenbrowne.com/ser-38.html for the insight.
Public Function AddMsXmlLibrary(Optional PathFileExtStr As String = "C:\Windows\System32\msxml6.dll") As Integer
On Error GoTo FoundError
AddMsXmlLibrary = 1
References.AddFromFile (PathFileExtStr)
AllDone:
Exit Function
FoundError:
On Error Resume Next
AddMsXmlLibrary = 0
On Error GoTo 0
End Function
I'm trying to run an integration test on my class to make sure an event i expect to be raised is raised:
'integration test not unit test
<TestMethod()>
Public Sub Change_Network_File_Causes_Event_To_Be_Raised()
Dim EventCalled As Boolean
Dim deployChk = New TRSDeploymentCheck("foo")
deployChk._localFile = Path.Combine(AppDomain.CurrentDomain.BaseDirectory, "TestFiles\SameLocalGUIDFile.txt")
AddHandler deployChk.DeploymentNeeded, Sub() EventCalled = True
deployChk.NetworkFileLocation = Path.Combine(AppDomain.CurrentDomain.BaseDirectory, "TestFiles\SameNetGUIDFile.txt")
ChangeNetworkFile(Path.Combine(AppDomain.CurrentDomain.BaseDirectory, "TestFiles\SameNetGUIDFile.txt"))
Assert.IsTrue(EventCalled)
End Sub
Here is how i setup the FileSystemWatcher Object in my class:
Friend Property NetworkFileLocation As String
Set(value As String)
_netFileLoc = value
If File.Exists(value) Then
_watcher = New FileSystemWatcher(value.Replace(Path.GetFileName(value), String.Empty))
_watcher.EnableRaisingEvents = True
AddHandler _watcher.Changed, AddressOf OnNetworkFileChanged
End If
End Set
Get
Return _netFileLoc
End Get
End Property
Private Sub OnNetworkFileChanged(source As Object, e As FileSystemEventArgs)
If IsDeploymentNeeded() Then RaiseEvent DeploymentNeeded()
End Sub
I put a breakpoint in the OneNetworkFileChange sub. The breakpoint is never hit. I have verified the file is actually being changed in ChangeNetworkFile I even copied the code (except for hard coding the path) and copied it into a windows app which i ran during my unit test. It worked in my windows app. What am i missing here?
Finally figured it out after some testing. Well the reason EventCalled is never true above is because the "windows message pump" for the test is blocked. The event will be fired but only after the test completes (which of course is to late). So how do you fix it? Its kind of messy and i don't like it but i referenced System.Windows.Forms.dll & called Application.DoEvents()
'integration test not unit test
<TestMethod()>
Public Sub Change_Network_File_Causes_Event_To_Be_Raised()
Dim EventCalled As Boolean
Dim deployChk = New TRSDeploymentCheck("foo")
deployChk._localFile = Path.Combine(AppDomain.CurrentDomain.BaseDirectory, "TestFiles\SameLocalGUIDFile.txt")
AddHandler deployChk.DeploymentNeeded, Sub() EventCalled = True
deployChk.NetworkFileLocation = Path.Combine(AppDomain.CurrentDomain.BaseDirectory, "TestFiles\SameNetGUIDFile.txt")
ChangeNetworkFile(Path.Combine(AppDomain.CurrentDomain.BaseDirectory, "TestFiles\SameNetGUIDFile.txt"))
Application.DoEvents()
Assert.IsTrue(EventCalled)
End Sub
Until some tells me a better way this appears to be the solution.
Probably its the filter (string.Empty) which apparently only looks at files without an extension (that's an assumption).
Try "*.*" or something like this:
_watcher = New FileSystemWatcher(value.Replace(Path.GetFileName(value), string.Concat("*.", Path.GetExtension(value))))