I'm new to this site. I have searched thoroughly for an answer and cannot seem to locate an answer. I hope one of you fine people will be able to help me....
Thank you
When I try to run my custom form with code show below, I get the following message:
Script Error
Expected statement
Line No:33
Code:
Function Item_Open()
Dim LeaveItem
Dim IO
If not Connection_Open Then
MsgBox("Error connecting to SI")
LeaveItem = True
Item_Open = False
Else
Item_Open = False
End If
End Function
Function Item_Close()
If LeaveItem = True Then
Exit_Function
Else
End If
End Function
Subroutine Connection_Open()
Dim oSI
Set oSI = New ADODB.Connection
Dim ostrSI
oSI.ConnectionString = "Driver={Progress OpenEdge 10.1C Driver};HOST=192.168.1.1;DB=kob;UID=sii;PWD=sisys1;PORT=2501;"
oSI.Open
End Sub
Change
Subroutine Connection_Open()
to
Sub Connection_Open()
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'm having some trouble figuring out what's wrong with my VBScript code as it's giving me
Script Engine Error:62:Input past end of file
when i'm trying to run
Function FSORead(ini,Section,Key,defval)
Set FSO = CreateObject("Scripting.FileSystemObject")
Set File = FSO.OpenTextFile("C:\Documents and Settings\ndtm\Application Data\IceChat\Scripts\"+ini)
keysearch = False
Do Until File.AtEndOfStream
if keysearch = False then
if File.ReadLine = "["&Section&"]" then
keysearch = True
end if
else
if Key = Mid(File.ReadLine,1,instr(File.ReadLine,"=")-1) then
FSORead = Mid(File.ReadLine,len(Key)+1)
end if
if Mid(File.ReadLine,1,1) = "[" then
FSORead = defval
end if
end if
Loop
FSORead = defval
End Function
And the File i'm calling does exist and does contain stuff like
[section1]
var1=randomvalue
[section2]
var=someothervalue
I have been trying different things but it's not working so i came here to see if someone could help me find what's wrong and how to fix it
Oh and this is the Sub calling it, it's made for a bot in a IRC network and the "SendCommand" basically allows you to execute non-script commands within the script itself
Sub FSOTest()
SendCommand "/msg #ndtm "&FSORead("http.ini","qtserver","survival","")
End Sub
Your
if Key = Mid(File.ReadLine,1,instr(File.ReadLine,"=")-1) then
tries to read two lines from the file. You need a variable that can be send to Mid and Instr.
Guys
I just wrote a vbs code snippet to automatically post in a forum. That's just for convenience. I encountered a wired problem:
I have several accounts. When I login as some accounts and use the script to automatically post, everything is OK. However, when I login as the other accounts and run the script, I got the error:
Error : Object required "getElementById(...)"
Code : 800a01a8
Source : Microsoft VBScript runtime error
I'm sure the object exists because I get it in the source of the webpage. I feel the error occurred randomly and I cannot get the regularity.
The script is ran in a Windows 8 OS and the browser is IE9. I'm a new learner of vbs and I don't know how to debug it. So I hope someone can help me. You can give me some clue.
Here is my code snippet:
Option Explicit
Dim IEApp
Dim iURL1
Dim iURL2
Dim iURL3
Dim iURL4
Dim iURL5
Set IEApp = CreateObject("InternetExplorer.Application")
iURL1="http://bbs.dealmoon.com/thread-299027-1-1.html"
iURL2="http://bbs.dealmoon.com/thread-299195-1-1.html"
iURL3="http://bbs.dealmoon.com/thread-299018-1-1.html"
iURL4="http://bbs.dealmoon.com/thread-299015-1-1.html"
iURL5="http://bbs.dealmoon.com/thread-299014-1-1.html"
Open iURL1
Open iURL2
Open iURL3
Open iURL4
Open iURL5
WScript.Echo("Done!")
Sub Wait(IE)
Do
WScript.Sleep 500
Loop While IE.ReadyState < 4 And IE.Busy
Do
WScript.Sleep 500
Loop While IE.ReadyState < 4 And IE.Busy
End Sub
Sub Post(IE)
Dim count
For count=0 To 9
With IE.Document
.getElementById("fastpostmessage").innerHTML = "good"
.getElementById("fastpostsubmit").click
Wait IE
WScript.Sleep GetRandom(7,15)
End With
Next
End Sub
Sub Open(PageURL)
IEApp.Visible = False
IEApp.Navigate PageURL
Wait IEApp
Post IEApp
End Sub
Function GetRandom(floor,ceil)
Randomize
GetRandom=Int((ceil - floor + 1) * Rnd + floor)*1000
End Function
You should call your POST routine after all the HTML content is loaded, for example in DOMContentLoaded or window.onload (for IE<9).
You dimmed IEApp, created the object, but you are not using it when trying to get the element ID. Your With block should look like this:
With IEApp.Document
.getElementById("fastpostmessage").innerHTML = "good"
.getElementById("fastpostsubmit").click
Wait IEApp
WScript.Sleep GetRandom(7,15)
End With
There are a few other places you only have IE instead of IEApp. Clear those up and your code should run fine.
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
It's been a day I've cracked my head to solve this....I've googled for solutions but none of it resolve my issue...
The code is like this:
Private Sub guh()
Dim oConn As Connection
Dim Record As Recordset
Dim SqlStr As String
SqlStr = "select * from dbo.Msg_History where Client_ID='2' AND Update_Msg='4'"
Set oConn = New Connection
With oConn
.CursorLocation = adUseClient
.CommandTimeout = 0
.Open "Provider=SQLOLEDB;Server=127.0.0.1;Initial Catalog=Table_Msg;UID=Admin;PWD="
End With
Set Record = oConn.Execute(SqlStr)
If IsNull(Record) Then
MsgBox "There are no records"
Else
MsgBox "There are records"
End If
oConn.Close
Set oConn = Nothing
End Sub
The sql statement is returning null recordset ..when i run the code...it always go to the "else" condition which is the line MsgBox "There are records"
I've tried change the line : If IsNull(Record) Then
to
If IsNull(Record.Fields(0).Value) Then
but then it throws an error like this:-
error: Either BOF or EOF is true, or the current record has been deleted. Requested operation requires a current record.
I've checked http://support.microsoft.com/kb/304267 and use eof and bof to the condition...n still get the same error..
please anyone help me...
I would use something like this:
' returns true if there is non empty recordset
Function isRSExists(rs) AS boolean
' has to exists as object
If Not rs Is Nothing Then
' has to be opened with recordset (could be empty)
If rs.State > 0 Then
' has to have some records
If Not rs.EOF Then
isRSExists = true
End If
End If
End If
End Function
Change this
If IsNull(Record) Then
to
If Record.RecordCount = 0 Then
I think you can test for if not Record.Eof.
If I recall correctly (it's been a long time), it only works with one type of cursor, I think it should be adUseServer. (EDIT No, it's actually RecordCount which has this problem)
I'll try and dig out some old code to check.
Thanks for the replies guys :D ...will test it later anyway...I havent's tested all of your suggestions at the time I'm posting this reply...I tested this: –
If Record.BOF And Record.EOF Then
and this works...