In the Form_Load event of this ultralegacy app I need to transliterate over to a web app is this command/statement "WaitOn" that occurs right after the On Error GoTo...
Does anyone remember what WaitOn means?
Here's the code snippet:
Dim sCmd As String
Dim iFileHandle As Integer
Dim sFileName As String
Dim i As Integer
Dim sKeyWord As String
Dim sWindowPosition As String
Dim iWindowState As Integer
Dim sSystemId As String
Dim sMetrics() As String
On Error GoTo MainFormLoadErr
WaitOn
ReDim gsFundsUsed(0 To 0)
ReDim gsObjectsUsed(0 To 0)
Set gsActiveSpread = Nothing
.
.
.
MainFormLoadExit:
WaitOff
Close
Exit Sub
MainFormLoadErr:
MsgBox Error$(Err) & " in MainForm Load"
Resume MainFormLoadExit
There is a corresponding WaitOff down there I just found. I don't think WaitOn is part of a line label.
As #C-Pound Guru suggested, WaitOn and WaitOff were methods in one of the (many) modules of the program. Not clear from the the names of the subroutines was the fact that their task was to set the mouse pointer to the Wait Cursor, and then return to the default, later.
Sub WaitOn ()
On Error Resume Next
Screen.MousePointer = 11
End Sub
Sub WaitOff ()
On Error Resume Next
Screen.MousePointer = 0
End Sub
I've never come across a 'WaitOn' or 'WaitOff' command in VB. You might want to double-check the code to see if there's a WaitOn method written (and a WaitOff method as well). It's not a label as VB labels end with a colon (:).
What happens if you right-click and Go To Definition? And does the code currently run?
Check the references - maybe it's something from a non-standard dll.
Related
I want to write a simple Excel macro, that invokes Add Digital Signature dialog for the user. I do not want to add the signature itself, just to show the Add Digital Signature dialog so that user doesn't have to look for it him or herself. I was googling for solution and understand that this can not be done in native Excel VBA. One has to call Windows Shell directly. How do I do that?
You don't state your Excel version but assuming you have a version with the ribbon UI. There are a couple of options - you can use the fluent UI control identifier and this code:
Option Explicit
Sub FindControlByFluentUIId()
Dim objCtrl As CommandBarControl
Dim lngId As Long
On Error GoTo ErrHandler
' magic number of Add Digital Signature
lngId = 13035
' find that control in the command bars collection
' this line throws an error for some workbooks !?
Set obj = Application.CommandBars.FindControl(Office.MsoControlType.msoControlButton, lngId)
' execute
If Not obj Is Nothing Then
obj.Execute
Else
MsgBox "Not found"
End If
End Sub
ErrHandler:
If Err.Number <> 0 Then
Debug.Print Err.Description
End If
End Sub
The full list of codes is here: https://www.microsoft.com/en-us/download/details.aspx?id=36798
If you didn't know the ID for some reason you can manually search each control collection of each command bar for a control with Caption this is like the one you are looking for. You are better off doing a wildcard search with the Like operator because you may not know the exact case of the control caption and position of the &s that facilitate keyboard short-cuts.
You can try something like this:
Option Explicit
Sub TestFindControl()
Dim strCaptionWild As String
Dim objCtrl As CommandBarControl
' use wildcards to help find the control
strCaptionWild = "*add*a*digital*signature*"
' call the function to find by caption
Set objCtrl = FindControl(strCaptionWild)
' execute on match
If Not objCtrl Is Nothing Then
Debug.Print "Command bar index: " & objCtrl.Parent.Index
Debug.Print "Control index: " & objCtrl.Index
Debug.Print "Real caption: " & objCtrl.Caption
objCtrl.Execute
Else
MsgBox "Not found for caption: " & strCaptionWild
End If
End Sub
Function FindControl(ByVal strCaption As String) As CommandBarControl
Dim objCb As CommandBar
Dim objCtrl As CommandBarControl
Dim blnFound As Boolean
On Error GoTo ErrHandler
' not found the control
blnFound = False
' iterate command bars and their controls
For Each objCb In Application.CommandBars
For Each objCtrl In objCb.Controls
' use like operator check control caption vs input caption
' LIKE enables use of wildcard matching
If LCase$(objCtrl.Caption) Like LCase$(strCaption) Then
' found it
blnFound = True
Exit For
End If
Next objCtrl
If blnFound Then Exit For
Next objCb
Set FindControl = objCtrl
Exit Function
ErrHandler:
Debug.Print Err.Description
Set FindControl = Nothing
End Function
Whenever I hit an error with my script, the focus turns to the VBA code and the offending line. I fix it, and hit save. Then I notice that the script is no longer running, even after I make sure that it's not paused.
For example, right now I'm using a Form_Timer() event to do some testing (interval set to 1000ms). To test the script again, I just set it to a minute in the future (e.g. if the current time is 8:54:00 AM I set it to fire at 8:55:00 AM). But this stops working after an error. Does anyone know why this is? I don't want to have to tell my users to close and re-open their copies of the Access DB just to make the script work again.
Code:
Private Sub Form_Timer()
On Error GoTo ErrorHandler
current_date_time = Now
If current_date_time = #6/28/2016 8:52:00 AM# Then
MsgBox ("the current_date_time variable holds: " & current_date_time)
'Declare objects
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim qdf As DAO.QueryDef
Dim oApp As Outlook.Application
Dim oMail As Outlook.MailItem
Dim mail_body As String
'Set objects
Set dbs = CurrentDb
Set qdf = dbs.QueryDefs("qry_BMBFLoc")
Set rst = qdf.OpenRecordset
Set oApp = New Outlook.Application
Set oMail = oApp.CreateItem(olMailItem)
mail_body = "The following jobs do not have the special BF location set in Job Orders: " & vbCrLf
If Not (rst.EOF And rst.BOF) Then
rst.MoveFirst
Do Until rst.EOF = True
mail_body = mail_body & rst!job & "-" & rst!suffix & vbCrLf
rst.MoveNext
Loop
'Email contents
oMail.Body = mail_body
oMail.Subject = "Blah"
oMail.To = "someone#something.com"
oMail.Send
'Close stuff
rst.Close
dbs.Close
Set rst = Nothing
Set oMail = Nothing
Set oApp = Nothing
End If
End If
Exit Sub
ErrorHandler:
Dim msg As String
If Err.Number <> 0 Then
msg = "email Form Timer Error #" & Str(Err.Number) & " error Line: " & Erl & Chr(13) & Err.Description
MsgBox msg, , "Error", Err.HelpFile, Err.HelpContext
End If
Exit Sub
End Sub
In order to reactivate the code, you could close the form when the error is triggered. The user would then have to reload the form to complete the action.
However, without any intervention the error is likely to occur again.
Edit: Or you could write a Function to automatically close, and re-open the offending form. Calling it in the on error command.
When there is an error in access form, the timer will stop working, you don't need to close and reopen the whole database, only the form to start the timer again. Otherwise you can add a button called "refresh" and bind macro to it which will turn the timer on again.
Yeah this sucks. I am writing a vba script for outlook and so the only way to debug is to close and reopen outlook after every error.
So I know that my code below works. The purpose is to create a tcp Ethernet connection between a scale and computer, so that when a weight is read on the scale, the value is displayed on the computer at the push of a button. I copied this code to a new lab machine that was just imaged for me. As for the winsock, I dynamically created it at run-time by adding it to the references. I understand that this is not what I am supposed to do (see: https://support.microsoft.com/en-us/kb/313984).
With a breakpoint at the CFixPicture_Initialize function, the code hits "set tcpC = new Winsock" line and breaks with error 429: avtiveX componenet can't create object. Does anybody have any ideas as to how I can get this license/get this Winsock control to work? Thanks!
Option Explicit
Private WithEvents tcpC As Winsock
Private Sub CFixPicture_Close()
Set tcpC = Nothing
End Sub
Private Sub CFixPicture_Initialize()
Set tcpC = New Winsock
tcpC.LocalPort = 0
tcpC.Connect "192.168.0.1", 8000
End Sub
Private Sub CommandButton1_click()
On Error GoTo errHandler
tcpC.SendData "S" & vbCrLf
Exit Sub
errHandler:
MsgBox "error:" & Err.Description
End Sub
Private Sub tcpC_DataArrival(ByVal bytesTotal As Long)
Dim strData As String
Dim strDataString As String
tcpC.GetData strData
strDataTrim = Mid(strData, 11)
Text1.Caption = "Weight: " & vbCrLf
The control is not present or is present but not registered on the new machine.
Copy over mswinsck.ocx from your *system directory to the new machines *system directory
Open a console as admnistrator and run regsvr32.exe c:\whatever\mswinsck.ocx
*\System32 or \SysWoW64 on 64 bit Windows.
As there was no license for the Winsock, I found a license online. I simply ran this program and voila! The Winsock worked. Thanks!
http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=4860&lngWId=1
I have a question about variable scope in VBScript. I know there's the following keywords (from autoitscript.com):
Dim = Local scope if the variable name doesn't already exist globally (in which case it reuses the global variable!)
Global = Forces creation of the variable in the Global scope
Local = Forces creation of the variable in the Local/Function scope
Imagine that I have the following .vbs file:
Dim strPath
strPath = "C:\folder"
DisplayPath strPath
Sub DisplayPath(strPath) 'Does this strPath get it's own local scope?
MsgBox strPath
End Sub
In the function: DisplayPath(strPath), is strPath a local variable? Or do functions/subs have access to the strPath defined at the top of the main section of the script as a global variable?
Also, what's the point of explicitly using Dim versus just defining variables as I use them, which is possible in scripting languages?
The strPath in the DisplayPath procedure will be a new variable but not for the reasons you expect, there is subtle problem with your code that will cloud the issue.
When calling Sub procedure the VBScript syntax does not include parentheses. For example:-
Sub MyProc(Param1, Param2)
'' # Do stuff
End Sub
MyProc("Hello", "World")
the above would result in a syntax error. It should be called:-
MyProc "Hello", "World"
Now when there is only one parameter a syntax error does not occur. This is because another use of parentheses is as part of an expression e.g. '(a + b) * c'. In the case of:-
DisplayPath(strPath)
VBScript resolves the "expression" (strPath) and pass the result to DisplayPath. Its this result that gives rise to new storage hold the result the expression.
Had you called with
DisplayPath strPath
no new created.
However what about this:-
Sub DisplayPath(something)
MsgBox something
End Sub
There is still no new storage allocated. something will point at the same memory that strPath does.
Edit
The code below works:-
Dim strPath
strPath = "c:\folder"
Display
Sub Display()
MsgBox strPath
End Sub
The declaration of strPath outside of a procedure causes it to have global scope.
As to the point of using explicit Dim what would happen if the assignment line above looked like this?
strPath = "c:\folder"
A new variable called strPath would come into existence and strPath would remain empty. You should always begin your VBScript files with the line:-
Option Explicit
This will force you to explicitly Dim all variables to be used and will save you hours of debugging time.
I'm trying to use Winsock to download some files and save them.
In my case, I have a MSHFlexGrid with 2 columns: one with URL and the other with the "path+filename" (where the file is going to be saved).
I'm iterating through all rows calling the next function:
Public Function DownloadSock(ArqURL As String, ArqDestino As String) As Boolean
'ArqURL is the file URL
'ArqDestino is where the downloaded file is going to be stored, in my hard disc
Dim arquivo() As Byte
Dim ficheiroID As Integer
ficheiroID = FreeFile
On Error GoTo Trata_erro
Open ArqDestino For Binary Access Write As #ficheiroID
Me.Winsock1.Connect ArqURL, 80
Me.Winsock1.GetData arquivo()
Put #ficheiroID, , arquivo()
Close #ficheiroID
DownloadSock = True
Exit Function
Trata_erro:
MDIForm1.Text1 = MDIForm1.Text1 & "Error! " & Err.Number & Err.Description & " - " & Err.Source & " - URL: " & ArqURL & " - Destino: " & ArqDestino & vbNewLine
DownloadSock = False
End Function
I'm getting this error
40006: Wrong protocol or connection
state for the requested transaction or
request
What am I doing wrong?
Have you checked out this Microsoft Support page? It indicates there's a bug in the Winsock control and the hotfix may be helpful.
Another thing to try is to make sure your winsock connection is open before trying to read/send data, and if it is closed, reopen a new connection:
if winsock.state=9 ' error state
winsock.close
while winsock.state<>0 ' closed state
doEvents
wend ' you need a while loop, because it doesn't close "immediately".
end if
' now you reopen it, or do whatever else you need
You might also consider changing your connection code to something like:
With Winsock1
If .State <> sckClosed Then .Close
.RemoteHost = ArqURL
.RemotePort = 80
.Connect
End With
One last thing. Check out this post on using the Winsock control.
I think you have overestimated the power of the Winsock control. You can't just use the Winsock's GetData method to reach out and grab a file. There has to be an active connection between your client application and some other application on the server side. After a connection is established, this server application will feed data to your application, the Winsock's DataArrival event will fire, and then you can use the GetData method to retrieve it. Your code should look more like this:
Public Sub DownloadSock(ArqURL As String)
Dim arquivo() As Byte
Dim ficheiroID As Integer
ficheiroID = FreeFile
Me.Winsock1.Connect ArqURL, 80
End Function
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim ArqDestino As String
Dim arquivo() As Byte
Dim ficheiroID As Integer
ficheiroID = FreeFile
Open ArqDestino For Binary Access Write As #ficheiroID
Me.Winsock1.GetData arquivo()
Put #ficheiroID, , arquivo()
Close #ficheiroID
End Sub
This is far from complete however (nor is it guaranteed to be syntactically correct, consider it pseudo code). After making the connection, you then have to implement some mechanism to tell the server to begin sending the file. If the file is large enough it will take many DataArrival events to get it all, so it will have to be held in an accumulator while the data comes across. There's more to this than you think.
I would take a look at some tutorials and/or sample code (look for a VB6 project that uses the Winsock control on CodeProject, like this one).