I have a little problem with a simple vbScript. The script has to run 2 action one after the other.
Option Explicit
Dim WshShell
Dim Yesterday
Dim resultat
Dim commande
Dim Jour
Set WshShell = WScript.CreateObject("WScript.Shell")
Yesterday = DateAdd("d", -2, Date())
resultat = "00001"
resultat = resultat & Right(Year(Yesterday), 2)
Jour = (Datepart("y", Yesterday))
If ((Jour < 100) and (Jour > 9)) Then resultat = resultat & "0" & Jour
If (Jour < 10) Then resultat = resultat & "00" & Jour
If (Jour >= 100) Then resultat = resultat & Jour
resultat = """(&(objectClass=eTGlobalUser)(eTSuspended=0)(eTRoleDN=*)(eTUpdateDate>=" & resultat & "))"""
commande = GetScriptPath() & "PharosGDH.exe /ldapfilter:" & resultat & " /conso"
WshShell.Run commande, 5, true
commande2 = GetScriptPath() & "PharosGDH.exe /all /auditPharos
WshShell.Run commande2, 5, true
WScript.Quit 1
Function GetScriptPath()
GetScriptPath = Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\"))
End Function
Can someone tell me what is wrong please?
Sorry the declaration was missing on the copy/past, And the windows juste shutdown silently, after that i see that result is not has it suposed to be!
Is this your actual code? There are at least two syntax errors in it:
First syntax error:
commande2 = GetScriptPath() & "PharosGDH.exe /all /auditPharos
There are double quotes missing at the end of the line:
commande2 = GetScriptPath() & "PharosGDH.exe /all /auditPharos"
Second syntax error:
Dim resultat
Dim commande
Dim Jour
The variable "commande2" is used, but not declared. Use:
Dim resultat
Dim commande
Dim commande2
Dim Jour
If this does not fix your problem, as the others have said, please tell us, what the problem is: Error message? Wrong behaviour?
Second attempt
Maybe display the commands used before executing them to be able to check that they contain the right content:
commande = GetScriptPath() & "PharosGDH.exe /ldapfilter:" & resultat & " /conso"
WshShell.Popup commande
WshShell.Run commande1, 5, true
commande2 = GetScriptPath() & "PharosGDH.exe /all /auditPharos"
WshShell.Popup commande
WshShell.Run commande2, 5, true
WScript.Quit 1
Related
I have a message box that repeats itself whenever you click ok- which is the only option, by the way.
My code:
'Very Annoying script'
Set objShell = CreateObject("Wscript.Shell")
intMessage = Msgbox("Click ok to say yes",16, "Is this messagebox annoying?")
If intMessage = vbOK Then
RETRY
Else
Wscript.Quit
End If
SUB RETRY
'Very Annoying script'
Set objShell = CreateObject("Wscript.Shell")
intMessage = Msgbox("Click ok to say yes",16, "Is this messagebox annoying?")
If intMessage = vbOK Then
RETRY
Else
Wscript.Quit
End If
End sub
Can I end the following script without ending the process labeled Micorosft Windows based Script Host'?
That includes not running the cmd line (It won't work)
taskkill /im wscript.exe
OR
going to the task manager.
The only way to do end the script is to use
taskkill /f /im wscript.exe
Other then that, it will simply re-run the script (the same effect as when you just simply click ok)
Thank you to Jiang YD for answering
If you use this command taskkill /IM wscript.exe /F ; You kill all the running vbscript, but
If you have a lot of a running script in loop with differents paths, you can use this vbscript to choose which one to be killed or not .So the aim of this script is to select and focus to the process that you want to be killed and you can also save it in a log file.
Just give a try ;)
Option Explicit
Dim Titre,Copyright,fso,ws,NomFichierLog,temp,PathNomFichierLog,OutPut,Count,strComputer
If AppPrevInstance() Then
MsgBox "Il y a une instance déjà en cours" & VbCrLF & CommandLineLike(WScript.ScriptName),VbExclamation,"Il y a une instance déjà en cours"
WScript.Quit
Else
Copyright = "[© Hackoo © 2015 ]"
Set fso = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject( "Wscript.Shell" )
NomFichierLog="Killed Process.txt"
temp = ws.ExpandEnvironmentStrings("%temp%")
PathNomFichierLog = temp & "\" & NomFichierLog
Set OutPut = fso.CreateTextFile(temp & "\" & NomFichierLog,1)
strComputer = "."
Call Find("wscript.exe")
Call Explorer(PathNomFichierLog)
End If
'***************************************************************************************************
Function Explorer(File)
Dim ws
Set ws = CreateObject("wscript.shell")
ws.run "Explorer "& File & "\",1,True
end Function
'***************************************************************************************************
Sub Find(MyProcess)
Dim colItems,objItem,Processus,Question
Titre = " Processus "& DblQuote(MyProcess) &" en cours d'exécution "
Set colItems = GetObject("winmgmts:").ExecQuery("Select * from Win32_Process " _
& "Where Name like '%"& MyProcess &"%' AND NOT commandline like " & CommandLineLike(WScript.ScriptFullName) & "",,48)
Count = 0
For Each objItem in colItems
Count= Count + 1
'Processus = Mid(objItem.CommandLine,InStr(objItem.CommandLine,""" """) + 2) 'Extraction du chemin du script en ligne de commande
Processus = objItem.CommandLine 'Replace(Processus,chr(34),"")
Question = MsgBox ("Voulez-vous arrêter ce script : " & DblQuote(Processus) & " ?" ,VBYesNO+VbQuestion,Titre+Copyright)
If Question = VbYes then
objItem.Terminate(0)'Tuer ce processus
OutPut.WriteLine Processus
else
Count= Count - 1 'décrementer le compteur de -1
End if
Next
OutPut.WriteLine String(100,"*")
OutPut.WriteLine count & Titre & "ont été arrêtés"
OutPut.WriteLine String(100,"*") & VbCrLF
End Sub
'**************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**************************************************************************
Function AppPrevInstance()
With GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
With .ExecQuery("SELECT * FROM Win32_Process WHERE CommandLine LIKE " & CommandLineLike(WScript.ScriptFullName) & _
" AND CommandLine LIKE '%WScript%' OR CommandLine LIKE '%cscript%'")
AppPrevInstance = (.Count > 1)
End With
End With
End Function
'**************************************************************************
Sub Pause(Minutes)
Wscript.Sleep(Minutes*1000*60)
End Sub
'**************************************************************************
Function StripProcPath(ProcessPath)
Dim arrStr : arrStr = Split(ProcessPath, "\")
StripProcPath = arrStr(UBound(arrStr))
End Function
'**************************************************************************
Function CommandLineLike(ProcessPath)
ProcessPath = Replace(ProcessPath, "\", "\\")
CommandLineLike = "'%" & ProcessPath & "%'"
End Function
'**************************************************************************
I am trying to write a vbscript that uses Google speech to the pronunciation of a message.
I have to save the code into notepad ++ with UTF8 encoding without BOM and pronunciation is good, but the display of the message box is not good for accented characters.
How to solve this problem ?
Thank you!
Option Explicit
Call Ip_Publique()
'***********************************************************************************************************************************************************
Sub Ip_Publique()
Dim Titre,URL,ie,objFSO,Data,OutPut,objRegex,Match,Matches,ip_public
Dim Message,URLFR
Message = "Vous êtes connecté à internet !" & VbCrlf & "Votre IP Publique est : "
URLFR = "http://translate.google.com/translate_tts?ie=UTF-8&tl=fr&q=" & Message
Titre = "Adresse Ip Publique !"
URL = "http://monip.org"
If OnLine("smtp.gmail.com") = True Then
Set ie = CreateObject("InternetExplorer.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
ie.Navigate (URL)
ie.Visible=False
DO WHILE ie.busy
Wscript.Sleep 100
Loop
Data = ie.document.documentElement.innertext
Set objRegex = new RegExp
objRegex.Pattern = "\b([0-9]{1,3}\.){3}[0-9]{1,3}\b"
objRegex.Global = False
objRegex.IgnoreCase = True
Set Matches = objRegex.Execute(Data)
For Each Match in Matches
Call Kill("wmplayer.exe")
Call WmPlaySound(URLFR & Match.Value)
MsgBox Message & Match.Value,64,Titre
Pause(10)
Call Kill("wmplayer.exe")
Next
ie.Quit
Set ie = Nothing
Else
MsgBox "Vérifier votre connexion internet puis re-executer ce script",48,Titre
Exit Sub
End If
End Sub
'************************************************************************************************************************************************************
Function OnLine(strHost)
Dim objPing,z,objRetStatus,PingStatus
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & strHost & "'")
z = 0
Do
z = z + 1
For Each objRetStatus In objPing
If IsNull(objRetStatus.StatusCode) Or objRetStatus.StatusCode <> 0 Then
PingStatus = False
Else
PingStatus = True
End If
Next
Call Pause(1)
If z = 4 Then Exit Do
Loop until PingStatus = True
If PingStatus = True Then
OnLine = True
Else
OnLine = False
End If
End Function
'*********************************************************************************************
'Fonction pour ajouter les doubles quotes dans une variable
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
Sub WmPlaySound(MySound)
Dim WshShell
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run "wmplayer "& DblQuote(MySound) &"",0,False
Set WshShell = Nothing
End Sub
'**********************************************************************************************
Sub Kill(Process)
Dim Ws,Command,Execution
Set Ws = CreateObject("WScript.Shell")
Command = "cmd /c Taskkill /F /IM "&Process&""
Execution = Ws.Run(Command,0,True)
End Sub
'**********************************************************************************************
Sub Pause(NSeconds)
Wscript.Sleep(NSeconds*1000)
End Sub
'**********************************************************************************************
OK, i solved it like this and you can give a try and post me your feed back.
The script is saved as ANSI and it worked well for me.
Description :
This script will display three messages box with 3 different languages with Google Voice Speech.
English
French
Arabic
Option Explicit
Call Ip_Publique()
'***********************************************************************************************************************************************************
Sub Ip_Publique()
Dim Titre,URL,ie,objFSO,Data,OutPut,objRegex,Match,Matches,ip_public,IP
Dim MessageEN,MessageFR,MessageAR,URLEN,URLFR,URLAR,Copyright
Copyright = "(2014 © Hackoo)"
MessageEN = "You are connected to the internet !" & VbCrlf & "Your Public IP Adress is "
MessageFR = "Vous êtes connecté à internet !" & VbCrlf & "Votre IP Publique est "
MessageAR = ChrW(1571)&ChrW(1606)&ChrW(1578)&ChrW(32)&ChrW(1605)&ChrW(1578)&ChrW(1589)&ChrW(1604)&_
ChrW(32)&ChrW(1576)&ChrW(1588)&ChrW(1576)&ChrW(1603)&ChrW(1577)&ChrW(32)&ChrW(1575)&ChrW(1604)&ChrW(1573)&_
ChrW(1606)&ChrW(1578)&ChrW(1585)&ChrW(1606)&ChrW(1578)& VbCrlf & "IP "
URLEN = "http://translate.google.com/translate_tts?tl=en&q=" & MessageEN
URLFR = "http://translate.google.com/translate_tts?tl=fr&q=" & MessageFR
URLAR = "http://translate.google.com/translate_tts?ie=UTF-8&tl=ar&q=" & MessageAR
Titre = "Adresse IP Publique " & Copyright
URL = "http://monip.org"
If OnLine("smtp.gmail.com") = True Then
Set ie = CreateObject("InternetExplorer.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")
ie.Navigate (URL)
ie.Visible=False
DO WHILE ie.busy
Wscript.Sleep 100
Loop
Data = ie.document.documentElement.innertext
Set objRegex = new RegExp
objRegex.Pattern = "\b([0-9]{1,3}\.){3}[0-9]{1,3}\b"
objRegex.Global = False
objRegex.IgnoreCase = True
Set Matches = objRegex.Execute(Data)
For Each Match in Matches
IP = Match.Value
Call NavigateIE(URLEN & IP)
MsgBox MessageEN & IP,64,Titre
Call NavigateIE(URLFR & IP)
MsgBox MessageFR & IP,64,Titre
Call NavigateIE(URLAR & IP)
MsgBox MessageAR & IP,64,Titre
Next
ie.Quit
Set ie = Nothing
Else
MsgBox "Vérifier votre connexion internet puis re-executer ce script",48,Titre
Exit Sub
End If
End Sub
'************************************************************************************************************************************************************
Function OnLine(strHost)
Dim objPing,z,objRetStatus,PingStatus
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & strHost & "'")
z = 0
Do
z = z + 1
For Each objRetStatus In objPing
If IsNull(objRetStatus.StatusCode) Or objRetStatus.StatusCode <> 0 Then
PingStatus = False
Else
PingStatus = True
End If
Next
Call Pause(1)
If z = 4 Then Exit Do
Loop until PingStatus = True
If PingStatus = True Then
OnLine = True
Else
OnLine = False
End If
End Function
'*********************************************************************************************
'Fonction pour ajouter les doubles quotes dans une variable
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
Sub Pause(NSeconds)
Wscript.Sleep(NSeconds*1000)
End Sub
'**********************************************************************************************
Sub NavigateIE(URL)
Dim objExplorer
Set objExplorer = CreateObject("InternetExplorer.Application")
with objExplorer
.Navigate(URL)
.Visible = False
end with
End Sub
'**********************************************************************************************
I have a vbscript on a Windows 7 machine in a branch office. It works just fine. I copied the code to a second branch office Windows 7 machine and I get an error. I'm out of ideas.
Both Windows machines have MS Outlook installed.
Do While asObj.ConnectionState = asCONN_CONNECTED
WeekDayNumber = Weekday(Now())
HourNumber = Hour(Now())
'WScript.Echo asObj.HasData
If asObj.HasData Then
WScript.Echo asObj.ReceiveString
WriteData asObj.ReceiveString
uploadData
CycleDate = Now()
asObj.Sleep 300
Else
If WeekDayNumber > 1 And WeekDayNumber < 7 And HourNumber > 8 And HourNumber < 17 Then
DiffInMinutes = DateDiff("n",CycleDate,Now())
'WScript.Echo "Day=" & WeekDayNumber & vbCrLf & "Hour=" & HourNumber & vbCrLf & "cycle=" & CycleDate & vbCrLf & "diff=" & DiffInMinutes & vbCrLf & " Now=" & Now()
If DiffInMinutes > 2 Then
SendAlertEmail
WriteData "Alert email sent " & Now() & vbCrLf
WScript.Echo cyclecounter & " no data"
CycleDate = Now()
' Sleep 5 minutes
asObj.Sleep 1000
End If
End If
End If
Loop
' And finally, disconnect
WScript.Echo "Disconnect -- we should never get to this point. Call Chris!"
asObj.Disconnect
Else
WScript.Echo "bad connection. You have to restart the script"
End If
Sub WriteData(sData)
Const ForAppending = 8
Const OutputFile = "d:\calldata\calldata_data\CallData_$DATE$mtp.txt"
Dim DateNow
Dim varDate
Dim objFile
Dim objFSO
' WScript.Echo sData
Datenow = Date()
varDate = Year(DateNow) & Right("0" & Month(DateNow), 2) & Right("0" & Day(DateNow), 2)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(Replace(OutputFile, "$DATE$", varDate), ForAppending, True)
objFile.WriteLine sData
objFile.Close
Set objFile = Nothing
Set objFSO = Nothing
End Sub
Sub uploadData
Dim objShell
Set objShell = Wscript.CreateObject("WScript.Shell")
objShell.Run "c:\calldata\FTPupload.vbs",10,True
objShell.Run "c:\calldata\updateCallData.vbs",10,True
' Using Set is mandatory
Set objShell = Nothing
End Sub
Sub SendAlertEmail
Set email = CreateObject("CDO.Message")
WScript.Echo "step 1"
email.Subject = "MTP - Possible phone time collection failure"
email.From = "x#gmail.com"
email.To = "x#x.com;x#x.com;x#x.com"
email.TextBody = Now() & " The collection of phone time that is done on the MTP Domain Controller seems to have failed. There has been no data for quite a while."
email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 'basic (clear-text) authentication
email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "x#gmail.com"
email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing")=2
email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver")="smtp.gmail.com"
email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")=25
email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = 1
email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
email.Configuration.Fields.Update
email.Send
If Err Then
WScript.Echo "SendMail Failed:" & Err.Description
End If
set email = Nothing
'WScript.Echo"step 2"
End Sub
Gmail is on 465 and not enough is specified.
Here's working code
Set emailObj = CreateObject("CDO.Message")
emailObj.From = "d#gmail.com"
emailObj.To = "d#gmail.com"
emailObj.Subject = "Test CDO"
emailObj.TextBody = "Test CDO"
emailObj.AddAttachment "c:\windows\win.ini"
Set emailConfig = emailObj.Configuration
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = true
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = "d"
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "Password1"
emailConfig.Fields.Update
emailObj.Send
If err.number = 0 then Msgbox "Done"
I have received this error before, and for me it was the security rights between one computer and another. it will be worth checking the access rights on the two machines and see if there are differences.
I have this piece of code from the ScriptIT guys.
Set objSysInfo = CreateObject("ADSystemInfo")
strComputer = objSysInfo.ComputerName
Set objComputer = GetObject("LDAP://" & strComputer)
arrOUs = Split(objComputer.Parent, ",")
arrMainOU = Split(arrOUs(0), "=")
wscript.echo arrMainOU(1)
The problem I'm having is that arrMainOU(1) echoes the OU twice. I tried setting up a simple test, but it fails. I don't see this issue covered here or on google.
If arrMainOU(1) = "myOU" Then
wcript.echo "true"
End If
I need to compare 1 value within arrMainOU(1) to an array that contains OU strings. I need a case statement that performs actions depending on whether it's OU1 or OU2 and so on.
I'm getting stuck at evaluating arrMainOU(1) though. If I output the value to a file, then it only writes one value.
Any help would be appreciated - Thank you
Try this code snippet to understand the 'SPLIT' function:
Set objSysInfo = CreateObject("ADSystemInfo")
strComputer = objSysInfo.ComputerName
Set objComputer = GetObject("LDAP://" & strComputer)
arrOUs = Split(objComputer.Parent, ",")
retstring = ""
For ii = LBound( arrOUs) To UBound( arrOUs)
arrMainOU = Split(arrOUs(ii), "=")
For jj = LBound( arrMainOU) To UBound( arrMainOU)
retstring = retstring & "arrOUs(" & CSTR( ii) & ") = " & arrOUs(ii) & vbTab
retstring = retstring & "arrMainOU(" & CSTR( jj) & ") = " & arrMainOU(jj) & vbNewLine
Next
retstring = retstring & vbNewLine
Next
Wscript.Echo retstring
How can I check for registry value using VbScript?
Function ReadFromRegistry(strRegistryKey, strDefault)
Dim WSHShell, value
On Error Resume Next
Set WSHShell = CreateObject("WScript.Shell")
value = WSHShell.RegRead( strRegistryKey )
If err.number <> 0 Then
readFromRegistry = strDefault
Else
readFromRegistry = value
End If
Set WSHShell = Nothing
End Function
Usage :
str = ReadfromRegistry("HKEY_LOCAL_MACHINE\SOFTWARE\Adobe\ESD\Install_Dir", "ha")
WScript.echo "returned " & str
Original post
Try something like this:
Dim windowsShell
Dim regValue
Set windowsShell = CreateObject("WScript.Shell")
regValue = windowsShell.RegRead("someRegKey")
This should work for you:
Dim oShell
Dim iValue
Set oShell = CreateObject("WScript.Shell")
iValue = oShell.RegRead("HKLM\SOFTWARE\SOMETHINGSOMETHING")
Try this. This script gets current logged in user's name & home directory:
On Error Resume Next
Dim objShell, strTemp
Set objShell = WScript.CreateObject("WScript.Shell")
strTemp = "HKEY_CURRENT_USER\Volatile Environment\USERNAME"
WScript.Echo "Logged in User: " & objShell.RegRead(strTemp)
strTemp = "HKEY_CURRENT_USER\Volatile Environment\USERPROFILE"
WScript.Echo "User Home: " & objShell.RegRead(strTemp)
Set objShell = WScript.CreateObject("WScript.Shell")
skey = "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\{9A25302D-30C0-39D9-BD6F-21E6EC160475}\"
with CreateObject("WScript.Shell")
on error resume next ' turn off error trapping
sValue = .regread(sKey) ' read attempt
bFound = (err.number = 0) ' test for success
end with
if bFound then
msgbox "exists"
else
msgbox "not exists"
End If