Hello scripters, I'm having some issues converting some VBA code to run in VB script format and i could use some help please.
I have the following VBA code that runs in a module and works perfectly. The code loops a WSH shell call to a executable, then waits for the exe to complete before moving to the next iteration. I don't necessarily need this code to be modified. I am running into issues trying to get code ported to run in VBS format. I've been doing some research on various components of VBA that dont exist in VBS, but i dont that applies here. Thanks for looking. The first three snippets all run from a VBA module, and the in progress stuff is just that. I basically copied the VBA to a new file and started to strip out and reformat syntax, to the best of my ability. I'm also assuming i'll need/use the APIs in the same way as before...this is foggy to me
' Working VBA declarations for ShellandWait
Option Explicit
' Constant for the dwDesiredAccess parameter of the OpenProcess API function.
Private Const PROCESS_QUERY_INFORMATION As Long = &H400
' Constant for the lpExitCode parameter of the GetExitCodeProcess API function.
Private Const STILL_ACTIVE As Long = &H103
' For error handling
Public gszErrMsg As String
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, ByRef lpExitCode As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'only needed for sleep'
' Working usage of VBA
Public Sub RunProgs(ByVal param_2 as String)
Dim parameter_1 as String
On Error GoTo ErrorHandler
parameter_1 = "C:\Users\sendmail.exe" & param_2
' Clear the error message variable.
gszErrMsg = vbNullString
If Not ShellAndWait(parameter_1, vbHide) Then Err.Raise 9999
Exit Sub
ErrorHandler:
'If any errors arise, this will explain what they are.
MsgBox gszErrMsg, vbCritical, "SendMail Utility"
End Sub
' Shell and Wait Function called from RunProgs()
Public Function ShellAndWait(ByVal szCommandLine As String, Optional ByVal iWindowState As Integer = vbHide) As Boolean
Dim lTaskID As Long
Dim lProcess As Long
Dim lExitCode As Long
Dim lResult As Long
On Error GoTo ErrorHandler
' Run the Shell function.
lTaskID = Shell(szCommandLine, iWindowState)
' Check for errors.
If lTaskID = 0 Then Err.Raise 9999, , "Shell function error."
' Get the process handle from the task ID returned by Shell.
lProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 0&, lTaskID)
' Check for errors.
If lProcess = 0 Then Err.Raise 9999, , "Unable to open Shell process handle."
' Loop while the shelled process is still running.
Do
' lExitCode will be set to STILL_ACTIVE as long as the shelled process is running.
lResult = GetExitCodeProcess(lProcess, lExitCode)
DoEvents
Loop While lExitCode = STILL_ACTIVE
ShellAndWait = True
Exit Function
ErrorHandler:
gszErrMsg = Err.Description
ShellAndWait = False
End Function
########The VBS starts here########
' In Progress declarations, need help here -- Not sure how to declare Function OpenProcess or GetExitCodeProcess in VBS??
' Constant for the dwDesiredAccess parameter of the OpenProcess API function.
Const PROCESS_QUERY_INFORMATION = &H400
' Constant for the lpExitCode parameter of the GetExitCodeProcess API function.
Const STILL_ACTIVE = &H103
Private Declare Function OpenProcess Lib "kernel32" (dwDesiredAccess,bInheritHandle,dwProcessId)
Private Declare Function GetExitCodeProcess Lib "kernel32" (hProcess,lpExitCode)
' In progress VBS usage
Public Sub RunProgs(param_2)
' Start program using parameter_1 + hide during execution
Dim parameter_1
parameter_1 = "C:\Users\sendmail.exe" & param_2
Call ShellAndWait(parameter_1,vbNormalFocus)
End Sub
' In progress Shell and Wait Function
Public Function ShellAndWait(program_name, window_style)
' Executes synchronously
Dim process_ID, process_handle
process_ID = Shell(program_name, window_style) 'should this be shellexecute?
process_handle = OpenProcess(SYNCHRONIZE, 0, process_id)
If process_handle <> 0 Then
WaitForSingleObject process_handle, INFINITE
CloseHandle process_handle
End if
End Function
Bookmarks