run msgbox in background VBscript - function

Two part question:
I am trying to write a VBscript where a loop runs, but there is a message box that the user can use to abort the sequence at anytime. I know that if you have a sequence with msgbox in it, the script will stop executing until an answer has been received, but can I run it as a subscript, so it doesn't interfere with the main script?
when I use the following script, I never see the msgbox
function test()
msgbox ("test")
end function
wscript.sleep 1000
msgbox "done
i was under the impression that function let you get inputs. Can this even be done with pure vbscript?

Not what I was going for but this is a work around I found. It makes a temporary msgbox that closes itself after a time. Gives the user a 5 second window to abort the sequence each loop.
set infobox = createobject("Wscript.shell")
do while E<N+1
E=E+1
if InfoBox.Popup ("Click cancel to stop sequence", _
5, "Abort Sequence?", 1) = 2 then
E=N+1
end if
loop

The Trick here is to have the first script create and start a second script. This second script will just run in the background and can then wait and kill the initial script Process... This can easily be done with a Function and can be called at the start of your script. When your main script ends, it simply kills the previously created second script. Note: the second script which is created will automatically delete itself upon being run. See the below Script for a good working example:
Dim iKillPID
'Start Kill Script At Start Of Script
iKillPID = KillPID()
For X = 10 To 0 Step -1
WScript.Echo "Closing in " & X & " Seconds"
WScript.Sleep 1000
Next
'Kill The Kill Script At End Of Script
GetObject("winmgmts:root\cimv2:Win32_Process.Handle='" & iKillPID & "'").Terminate
MsgBox "This Script is Complete"
'$$$$$$$$$$
Function KillPID()
Dim strKillScriptPath, strKillCommand, KillFile, StrFileKill, iScriptPID
Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
'Generates a Unique Temp File Name In The Same Directory As The Current Script
strKillScriptPath = objFSO.GetParentFolderName(WScript.ScriptFullName) & Chr(92) & Replace(objFSO.GetTempName, ".tmp", ".vbs")
'Command Line To New Kill Script
strKillCommand = "WScript.exe " & Chr(34) & strKillScriptPath & Chr(34)
'This part gets the Process ID of the Current Running Script
iScriptPID = GetObject("winmgmts:root\cimv2:Win32_Process.Handle='" & _
CreateObject("WScript.Shell").Exec("CMD /C ping 127.0.0.1 -n 2 > nul").ProcessID & "'").ParentProcessID
'String With Kill File Code (Script Process ID Included)
StrFileKill = _
"Const iKillProc = " & iScriptPID & vbCrLf & _
"Dim objFSO: Set objFSO = CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & ")" & vbCrLf & _
"objFSO.DeleteFile WScript.ScriptFullName, True" & vbCrLf & _ '<-- Deletes itself immediately upon running
"On Error Resume Next" & vbCrLf & _
"Set objKillProc = Nothing" & vbCrLf & _
"Set objKillProc = GetObject(" & Chr(34) & "winmgmts:root\cimv2:Win32_Process.Handle='" & Chr(34) & " & iKillProc & " & Chr(34) & "'" & Chr(34) & ")" & vbCrLf & _
"If objKillProc Is Nothing Then" & vbCrLf & _
" MsgBox " & Chr(34) & "The Process Is Not Running" & Chr(34) & vbCrLf & _
" WScript.Quit" & vbCrLf & _
"End If" & vbCrLf & _
"MsgBox " & Chr(34) & "Click OK To Kill The Script Process" & Chr(34) & vbCrLf & _
"Call KillProcess(iKillProc)" & vbCrLf & _
"WScript.Quit" & vbCrLf & _
"Sub KillProcess(iProcID)" & vbCrLf & _
"Dim objKillProc, strParentProc" & vbCrLf & _
"On Error Resume Next" & vbCrLf & _
"Set objKillProc = Nothing" & vbCrLf & _
"Set objKillProc = GetObject(" & Chr(34) & "winmgmts:root\cimv2:Win32_Process.Handle='" & Chr(34) & " & iProcID & " & Chr(34) & "'" & Chr(34) & ")" & vbCrLf & _
"If Err = 0 And Not objKillProc Is Nothing Then" & vbCrLf & _
" If StrComp(objKillProc.Name, " & Chr(34) & "cmd.exe" & Chr(34) & ", 1) = 0 Or _" & vbCrLf & _
" StrComp(objKillProc.Name, " & Chr(34) & "cscript.exe" & Chr(34) & ", 1) = 0 Or _" & vbCrLf & _
" StrComp(objKillProc.Name, " & Chr(34) & "wscript.exe" & Chr(34) & ", 1) = 0 Then" & vbCrLf & _
" strParentProc = objKillProc.ParentProcessID" & vbCrLf & _
" objKillProc.Terminate()" & vbCrLf & _
" Call KillProcess(strParentProc)" & vbCrLf & _
" End If" & vbCrLf & _
"End If" & vbCrLf & _
"Set strParentProc = Nothing" & vbCrLf & _
"Err.Clear" & vbCrLf & _
"End Sub"
'Write the Code To File
Set KillFile = objFSO.CreateTextFile(strKillScriptPath, True)
KillFile.WriteLine StrFileKill
KillFile.Close
Set KillFile = Nothing
WScript.Sleep 250
'Execute The Script and Return the Script Process ID So You Can Kill It When The Script Ends
KillPID = CreateObject("WScript.Shell").Exec(strKillCommand).ProcessID
End Function
'$$$$$$$$$$
Also, If you're using CScript as the Scripting Engine for your VBS, I believe you can stop the script by pressing CTRL + C in the Command Prompt Window.
Now if your super motivated you can create an HTA that does about the same thing, but present a UserForm or Custom Internet Explorer Window to click and it can also loop through and check if the process is still running and close itself when the script is finished and the process is no longer running. You can add pretty colors and everything too!

Related

Why is my vbCrLf not working?

I have to declare a variable in which I need to keep multiple sentences (vbscript is the language I am using). So, I put vbCrLf at the end of sentences in order to get a break. But it is not giving me the break instead it is giving me a whole paragraph.
strHtmlBody = "<div><font face='Arial' size='-1'>Greetings "& RS("firstname") &":"& vbCrLf & _
"Here is the email that contains your account information to access your account at www.example.com." & VbCrLf & VbCrLf & _
"Your Email Address: " & RS("Email") & VbCrLf & _
"Your Password : " & RS("Password") & VbCrLf & vbCrLf & _
"Remember, if you have any questions or concerns, please let us know, simply reply to this email." & VbCrLf & _
"ABC Company" & vbCrLf & _
"http://www.example.com" & vbCrLf & vbCrLf
strHtmlBody = strHtmlBody & "</div>"
HTML ignores most whitespace which vbCrLf represents. Use <br> tags in its place.

Set statement error

I am receiving the 3075 error (invalid operator) from the script below. The VBA error is marking the set statement in yellow. I don't understand why. What is lacking?
strSql = "SELECT FA_AVG.RadNr, (Left([Text],122)) AS LetaEfter1, Mid([Text],130,18) AS LetaEfter2, Right(Left([Text],184),36) AS LetaEfter3, FA_AVG.PerNr, FA_AVG.Fil, FA_AVG.GR1 " & _
"FROM FA_AVG " & _
"WHERE (((FA_AVG.RadNr)=20) AND ((Left([Text],122))='" & strTemp1 & "') AND ((Right(Left([Text],184),36))='" & strTemp3 & "') AND (Trim(FA_AVG.PerNr)='" & strPer & "'))"
Set rstAddData = CurrentDb.OpenRecordset(strSql)
Run this and study the output, and it will probably be quite clear to you why it won't run:
strSql = "SELECT FA_AVG.RadNr, (Left([Text],122)) AS LetaEfter1, Mid([Text],130,18) AS LetaEfter2, Right(Left([Text],184),36) AS LetaEfter3, FA_AVG.PerNr, FA_AVG.Fil, FA_AVG.GR1 " & _
"FROM FA_AVG " & _
"WHERE (((FA_AVG.RadNr)=20) AND ((Left([Text],122))='" & strTemp1 & "') AND ((Right(Left([Text],184),36))='" & strTemp3 & "') AND (Trim(FA_AVG.PerNr)='" & strPer & "'))"
Debug.Print strSQL

Access 2010 - Audit Trail with composite primary keys

I have been unable to find a solution to this problem, so I hope some of you may be of help. I'm trying to create an Audit Trail for an Access database to track changes. Many of my tables have composite primary keys (multiple fields combined to uniquely identify records). I obtained the following code for the Audit module:
Const cDQ As String = """"
Sub AuditTrail(frm As Form, recordid As Control)
'Track changes to data. 'recordid identifies the pk field's corresponding
'control in frm, in order to id record.
Dim ctl As Control
Dim varBefore As Variant
Dim varAfter As Variant
Dim strControlName As String
Dim strSQL As String
On Error GoTo ErrHandler
'Get changed values.
For Each ctl In frm.Controls
With ctl
'Avoid labels and other controls with Value property.
Select Case .ControlType
Case acTextBox
If .Value <> .OldValue Then
varBefore = .OldValue
varAfter = .Value
strControlName = .Name
'Build INSERT INTO statement.
strSQL = "INSERT INTO " _
& "Audit (EditDate, RecordID, SourceTable, " _
& " SourceField, BeforeValue, AfterValue) " _
& "VALUES (Now()," _
& cDQ & recordid.Value & cDQ & ", " _
& cDQ & frm.RecordSource & cDQ & ", " _
& cDQ & .Name & cDQ & ", " _
& cDQ & varBefore & cDQ & ", " _
& cDQ & varAfter & cDQ & ")"
'& cDQ & Environ("username") & cDQ & ", " _
'View evaluated statement in Immediate window.
Debug.Print strSQL
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
End If
Case acComboBox
If .Value <> .OldValue Then
varBefore = .OldValue
varAfter = .Value
strControlName = .Name
'Build INSERT INTO statement.
strSQL = "INSERT INTO " _
& "Audit (EditDate, User, RecordID, SourceTable, " _
& " SourceField, BeforeValue, AfterValue) " _
& "VALUES (Now()," _
'& cDQ & Environ("username") & cDQ & ", " _
& cDQ & recordid.Value & cDQ & ", " _
& cDQ & frm.RecordSource & cDQ & ", " _
& cDQ & .NAME & cDQ & ", " _
& cDQ & varBefore & cDQ & ", " _
& cDQ & varAfter & cDQ & ")"
'View evaluated statement in Immediate window.
Debug.Print strSQL
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
End If
Case acListBox
If .Value <> .OldValue Then
varBefore = .OldValue
varAfter = .Value
strControlName = .Name
'Build INSERT INTO statement.
strSQL = "INSERT INTO " _
& "Audit (EditDate, User, RecordID, SourceTable, " _
& " SourceField, BeforeValue, AfterValue) " _
& "VALUES (Now()," _
& cDQ & Environ("username") & cDQ & ", " _
& cDQ & recordid.Value & cDQ & ", " _
& cDQ & frm.RecordSource & cDQ & ", " _
& cDQ & .Name & cDQ & ", " _
& cDQ & varBefore & cDQ & ", " _
& cDQ & varAfter & cDQ & ")"
'View evaluated statement in Immediate window.
Debug.Print strSQL
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
End If
End Select
End With
Next
Set ctl = Nothing
Exit Sub
ErrHandler:
MsgBox Err.Description & vbNewLine _
& Err.Number, vbOKOnly, "Error"
End Sub
And then in the code for individual Forms I have the following code to run the module:
Option Compare Database
Private Sub Form_BeforeUpdate(Cancel As Integer)
Call AuditTrail(Me, HeaderID)
End Sub
I have found when I substitute the field name where HeaderID is for the name of a single valued primary key, the code works fine. When my table has multiple fields making up the primary key I am not sure how to format 'HeaderID' to recognize the composite of those values. I also have look up tables in some forms, but I'm unsure if that is contributing to the problem.
The error messages I'm getting:
Compile Error:
ByRef argument type mismatch
Any thoughts would be greatly appreciated!
Thank you,
Tiffany
Your AuditTrail subroutine takes as its parameters the form and the control where the edit to the data happens. So when you pass 'Me' and the name of the field (control), you're actually passing the current form and the control to the subroutine. When you change 'HeaderID' to anything other than a control name you will get the 'Type Mismatch' error because your subroutine is expecting a control and not a piece of data.
You will need to adjust your AuditTrail subroutine to take the index value that you actually want to store in your table. If your combined ID is a string made up of three values then change the parameter of the AuditTrail subroutine from 'control' to 'string'.

Storing client's installed software information into MySQL using VB Script?

I have a requirement of getting the installed applications informations into MySQL database, after searching in the net for hours I got vb script which is below. It should have two functionalities
it should save the data into a text file and
second is it should write into MySQL database.
I got the first one but for the second it is throwing an error
Object doesn't support this property or method : 'Execute'
code : 800A01B6
and code i have used is
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = objFSO.CreateTextFile("c:\scripts\software.tsv", True)
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colSoftware = objWMIService.ExecQuery _
("Select * from Win32_Product")
objTextFile.WriteLine "Caption" & vbtab & _
"Description" & vbtab & "Identifying Number" & vbtab & _
"Install Date" & vbtab & "Install Location" & vbtab & _
"Install State" & vbtab & "Name" & vbtab & _
"Package Cache" & vbtab & "SKU Number" & vbtab & "Vendor" & vbtab _
& "Version"
Dim objConnection
Dim objRecordSet
Set objConnection = CreateObject("ADODB.Connection")
Set objRecordSet = CreateObject("ADODB.Recordset")
connectionString = "Driver={MySQL ODBC 5.1 Driver};Server=localhost;Database=testing;User=root; Password=******;"
objConnection.Open connectionString
For Each objSoftware in colSoftware
objTextFile.WriteLine objSoftware.Caption & vbtab & _
objSoftware.Description & vbtab & _
objSoftware.IdentifyingNumber & vbtab & _
objSoftware.InstallDate2 & vbtab & _
objSoftware.InstallLocation & vbtab & _
objSoftware.InstallState & vbtab & _
objSoftware.Name & vbtab & _
objSoftware.PackageCache & vbtab & _
objSoftware.SKUNumber & vbtab & _
objSoftware.Vendor & vbtab & _
objSoftware.Version
objRecordSet.Execute "INSERT INTO Computers (Caption, Description, IdentifyingNumber, InstallDate2,InstallLocation,InstallState,Name,PackageCache,SKUNumber, Vendor, Version)"&"VALUES (objSoftware.Caption & vbtab &, objSoftware.Description & vbtab &, objSoftware.IdentifyingNumber & vbtab &, objSoftware.InstallDate2 & vbtab &, objSoftware.InstallLocation & vbtab &, objSoftware.InstallState & vbtab &, objSoftware.Name & vbtab &, objSoftware.PackageCache & vbtab &, objSoftware.SKUNumber & vbtab &, objSoftware.Vendor & vbtab &, objSoftware.Version)", objConnection, adOpenStatic, adLockOptimistic
Next
objTextFile.Close
objConnection.Close
The error is caused by the fact that the Recordset object has no .Execute method. In theory you should use Recordset.Open or Connection.Execute to execute a (parameter) query/statement.
Looking at the mess you made out of the INSERT statement, I advice you to LOAD DATA INFILE the .TXT data into your DBMS.
See:
load data infile
execute

VB+Crystal report

I wrote this code but I got "Run time error '91':"
Private Sub Command1_Click()
Set rs = New ADODB.Recordset
openConnection
If Me.cmbMonth = "" And Me.cmbYear = "" Then
MsgBox "Please select MONTH and YEAR"
Exit Sub
End If
With crystalrpt
.ReportFileName = App.Path & "\Report\VariableReport.rpt" <-- ERROR IS HERE
.SelectionFormula = "{SW.dtaMonth}='" & cmbMonth.Text & "' and {SW.dtaYear}=" & dtaYear.Text & "" & _
" and {SFW.dtaMonth}='" & cmbMonth.Text & "' and {SFW.dtaYear}=" & dtaYear.Text & "" & _
" and {OT.dtaMonth}='" & cmbMonth.Text & "' and {OT.dtaYear}=" & dtaYear.Text & "" & _
" and {CL.dtaMonth}='" & cmbMonth.Text & "' and {CL.dtaYear}=" & dtaYear.Text & "" & _
" and {RM.dtaMonth}='" & cmbMonth.Text & "' and {RM.dtaYear}=" & dtaYear.Text & "" & _
" and {EL.dtaMonth}='" & cmbMonth.Text & "' and {EL.dtaYear}=" & dtaYear.Text & "" & _
" and {TRANS.dtaMonth}='" & cmbMonth.Text & "' and {TRANS.dtaYear}=" & dtaYear.Text & "" & _
" and {WD.dtaMonth}='" & cmbMonth.Text & "' and {WD.dtaYear}=" & dtaYear.Text & "" & _
" and {MP.dtaMonth}='" & cmbMonth.Text & "' and {MP.dtaYear}=" & dtaYear.Text & "" & _
" and {NONSTOCK.dtaMonth}='" & cmbMonth.Text & "' and {NONSTOCK.dtaYear}=" & dtaYear.Text & "" & _
" and {PACK.dtaMonth}='" & cmbMonth.Text & "' and {PACK.dtaYear}=" & dtaYear.Text & ""
.WindowTitle = "Report"
.Action = 1 'Will Show The Report
End With
End Sub
It's possible that you are trying to create an instance of a class (an object) from a class that is present on the machines you tested it on, but not on the machine it's been deployed to..... for example, I happen to know that I can make a VB program utilize a class for Nero Burning Rom.... I can make a nero object, and use it's methods and properties...... but that will only work on machines that have the Nero libraries installed. If it's not installed, when you try to make the object (either through early or late bindings with new or createobject), the variable that SHOULD refer to the object is still set to Nothing, because the library failed to create an instance of the requested class.....