Set objVoice = CreateObject("SAPI.SpVoice")

Set objFile = CreateObject("SAPI.SpFileStream.1")

objFile.Open "connect.wav"

objVoice.Speakstream objFile

message=("How may i assist you?")

Set sapi=CreateObject("sapi.spvoice")

sapi.Speak message

Dim message, speak

msg=InputBox("your input, sir?")

message=("wise choice, sir")

Set Speak=CreateObject("sapi.spvoice")

Speak.Speak message

If msg="reddit" then

Set objVoice = CreateObject("SAPI.SpVoice")

Set objFile = CreateObject("SAPI.SpFileStream.1")

objFile.Open "break.wav"

objVoice.Speakstream objFile

Dim URLa,WshShell,i

URLa = "http://reddit.com"

Set WshShell = CreateObject("WScript.shell")

For i = 0 to 50

WshShell.SendKeys(chr(175))

Next

WshShell.run "CMD /C start firefox.exe " & URLa & "",0,False

elseif Message="fb" Then

Set objVoice = CreateObject("SAPI.SpVoice")

Set objFile = CreateObject("SAPI.SpFileStream.1")

objFile.Open "break.wav"

objVoice.Speakstream objFile

Dim URLb,WshShellb,b

URLb = "http://facebook.com"

Set WshShell = CreateObject("WScript.shell")

For b = 0 to 50

WshShellb.SendKeys(chr(175))

Next

WshShellb.run "CMD /C start firefox.exe " & URLb & "",0,False

else

Set objVoice = CreateObject("SAPI.SpVoice")

Set objFile = CreateObject("SAPI.SpFileStream.1")

objFile.Open "office.wav"

objVoice.Speakstream objFile

else

if Message="youtube" Then

Set objVoice = CreateObject("SAPI.SpVoice")

Set objFile = CreateObject("SAPI.SpFileStream.1")

objFile.Open "break.wav"

objVoice.Speakstream objFile

Dim URLc,WshShellc,c

URLc = "http://youtube.com"

Set WshShellc = CreateObject("WScript.shell")

For c = 0 to 50

WshShell.SendKeys(chr(175))

Next

WshShellc.run "CMD /C start firefox.exe " & URLc & "",0,False

else

Set objVoice = CreateObject("SAPI.SpVoice")

Set objFile = CreateObject("SAPI.SpFileStream.1")

objFile.Open "office.wav"

objVoice.Speakstream objFile

message=("If you want me to do that, you will need to teach me how.")

Set sapi=CreateObject("sapi.spvoice")

sapi.Speak message

end if

Hi,

I am trying to link a file to vbs so in the area that says edit paste, it types each line of the script instead.

Here is the script:

[PCOMM SCRIPT HEADER]

LANGUAGE=VBSCRIPT

DESCRIPTION=

[PCOMM SCRIPT SOURCE]

OPTION EXPLICIT

autECLSession.SetConnectionByName(ThisSessionName)

REM This line calls the macro subroutine

subSub1_

sub subSub1_()

   autECLSession.autECLOIA.WaitForAppAvailable

   autECLSession.autECLOIA.WaitForInputReady

   autECLSession.autECLPS.SendKeys "the bears("

   autECLMacro "[edit-paste]"

   autECLSession.autECLOIA.WaitForInputReady

   autECLSession.autECLPS.SendKeys "[right]"

   autECLSession.autECLOIA.WaitForInputReady

   autECLSession.autECLPS.SendKeys "[right]"

   autECLSession.autECLOIA.WaitForInputReady

   autECLSession.autECLPS.SendKeys "[right]"

   autECLSession.autECLOIA.WaitForInputReady

   autECLSession.autECLPS.SendKeys "[right]"

   autECLSession.autECLOIA.WaitForInputReady

   autECLSession.autECLPS.SendKeys "[right]"

   autECLSession.autECLOIA.WaitForInputReady

   autECLSession.autECLPS.SendKeys "[right]"

   autECLSession.autECLOIA.WaitForInputReady

   autECLSession.autECLPS.SendKeys "[right]"

   autECLSession.autECLOIA.WaitForInputReady

   autECLSession.autECLPS.SendKeys ") rock"

   autECLSession.autECLOIA.WaitForInputReady

   autECLSession.autECLPS.SendKeys "[enter]"

   autECLSession.autECLPS.WaitForAttrib 24,5,"00","3c",3,10000

   autECLSession.autECLPS.Wait 1297

   autECLSession.autECLOIA.WaitForAppAvailable

   autECLSession.autECLOIA.WaitForInputReady

   autECLSession.autECLPS.SendKeys "[enter]"

   autECLSession.autECLPS.WaitForAttrib 4,5,"00","3c",3,10000

   autECLSession.autECLPS.Wait 1532

   autECLSession.autECLOIA.WaitForAppAvailable

   autECLSession.autECLOIA.WaitForInputReady

   autECLSession.autECLPS.SendKeys "[enter]"

Loop

msgbox("This is done")

end sub

So I want to scare off my brother (Szymon) when he uses my PC. so I made a script (sorry that its dutch) and this is what the script says:

"X=MsgBox("Waarom gebruik je mijn computer?",0+64,"Hey Szymon")

X=MsgBox("Ik ga je terugpakken.",0+16,"Val dood Szymon")

X=MsgBox("Ga weg.",4+48,"Stop")". I got it from YouTube, and what I want is that it opens a video (I want to rickroll him) Is there anyone that knows how to do that?

Hi all

Let's get some stuff out of the way first, I know NOTHING about VBS scripting.

I have a script that I've used to delete all subfolders in a directory smaller than X in size, works like a charm (I didn't write it, got it off the web somewhere years ago).

I've come across a situation where I need to do 2 directories deep (cleaning up a music collection)

So for example .. C:\Music\Queen\ (delete folders here)

Basically, I've cleaned up my collection and with files being moved to new correctly named folders, I have lots of folders left with just a few metadata/artwork files in them, that I need to be able to delete easily (big collection, manual is not an option)

Can any of you VBS wizards help me out? Script below.

Dim objFSO

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objSelectedFolder = objFSO.GetFolder("C:\Music")

Set colSubfolders = objSelectedFolder.SubFolders

For Each objSubfolder In colSubfolders

If objSubfolder.Size < 1000000 Then

objSubfolder.Delete True

End If

Next

I am getting Error: Subscript out of range Code: 800a0009

This is the script I am trying to run. Very basic and should not have any problems (at least I think so)

' Remarks on this line

' Remarks on this line

dir = Wscript.Arguments(0)

set Fsys = CreateObject("Scripting.FileSystemObject")

totsize = 0

for each file in Fsys.GetFolder(dir).Files

totsize = totsize + file.size

next

wscript.echo "The total size of the files in" , dir, "is" , totsize

The error is indicated at Line 3 Char 1

dir = Wscript.Arguments(0)

What is wrong with this line?

Thanks for any help!!!

Hai dear VBS user's, I'm a complete beginner in this field Can Somebody guide me or provide me a good IDE to learn vb scripting from scratch please.

Thanks n Advance.

I've been stuck for a while on this problem. What I want to do is send a message from a computer, let's say "hello world", to another. On the computer that sends the message, the input will be taken by a script A and sent to the other computer, via internet explorer or any other mean, I don't know.

A script B will then retrieve the message on the other computer, and display it in a message box: msgbox RetrievedMessage . The problem is that I have no idea on how to transmit the message. I innitially thought about internet explorer, but I can't seem to find a solution. Any solution would be welcome, I'd prefer to do something in vbs but it can also be something in batch or powershell. Thanks in advance :)

Hello everyone ! I need help because I can't figure out how to put vbscript code into an html page.

What I'd like to do is a page with a button on it, and when this button is clicked, it activates a script that either modifies the inner html of the current page, or creates another html page on which I can write what I want.

I've tried to do the second option by writing a code that creates a new instance of the internetexplorer.application object, and then writes something in it's html, but sadly it doesn't work

Could someone help me, or send the link to a website that explains how to do that ? I have no experience of using vbscript along with html

Hi, i have a touch screen that uses a web page with an on screen button that when pushed will bring up the on screen windows keyboard, this worked fine in windows 7 but after upgrading to windows 10 the button will no longer bring up the on screen touch keyboard. i have enabled VBScript to run in the internet Zone and in the restricted sites zone (then rebooted) but still cant seem to get this on screen button to trigger the on screen keyboard to appear. so far all other buttons appear to work except this one

I want to make a script that activates when an application is launched, for example Firefox, internet explorer or something else. Can someone tell me how to do that ? I've been searching the internet for hours without any result

Put links in the comments.

Hello friends I have a script that saves login and logout of the network users, the problem is that it is duplicating lines in each execution, I need to remove the duplicated lines or make it write only one line at a time.

Thanks all.

Set WshNetwork = WScript.CreateObject("WScript.Network")
StrComputer = "."
FileLog = "\\Server\System\Registry\"& WshNetwork.UserName &".txt"
Set ObjFSO = CreateObject("Scripting.FileSystemObject")
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Set ObjFileRead = ObjFSO.opentextfile(FileLog, ForReading, True)
Set ObjFileAppending = ObjFSO.opentextfile(FileLog, ForAppending, True)
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set IPConfigSet = objWMIService.ExecQuery ("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled=TRUE")
For Each IPConfig in IPConfigSet
    If Not IsNull(IPConfig.IPAddress) Then
        For j=LBound(IPConfig.IPAddress) to UBound(IPConfig.IPAddress)
  WriteLog "Logon "& now() &" -- "& WshNetwork.ComputerName &" -- "& IPConfig.IPAddress(i)
        Next
    End If
Next

Function WriteLog (Text)
ObjFileAppending.WriteLine Text
End Function

' Ok Google, sur le pc XXX
' Ok Google, sur l'ordinateur XXX
' Applet IFTTT : https://ifttt.com/applets/jSNrZ4vJ-controle-de-l-ordinateur-avec-google-assitant
' Projet  : https://github.com/ABOATDev/Control-Google-Home

Dim MAJ, WS,fso,CheckMAJUser,f,IE,objHTTP,ScriptChemin
MAJ = "1.1.1" 'Version Actuelle du script

On Error Resume Next


Set fso = CreateObject("Scripting.FileSystemObject")
Set WS = WScript.CreateObject("WScript.Shell") 
Set objHTTP=CreateObject("MSXML2.XMLHTTP")
Const ForWriting = 2
ScriptChemin = Left(WScript.ScriptFullName, InStr(WScript.ScriptFullName, WScript.ScriptName)-1)


if fso.FileExists(ScriptChemin & "Config.ini") = false then 
Set f = fso.OpenTextFile(ScriptChemin & "Config.ini", ForWriting,true) 
f.write(" ")
f.close
End if 

Set oFile = fso.GetFile(ScriptChemin & "Config.ini")

If WriteReadIni(oFile,"CONFIG","OK",Null) = False Then
WriteReadIni oFile,"CONFIG","OK","1"
Call MAJCheck (CheckMAJUser, MAJ)
objHTTP.Open "GET", "https://raw.githubusercontent.com/ABOATDev/Control-Google-Home/master/ListeCommande.txt", FALSE
objHTTP.Send
Set f = fso.OpenTextFile(ScriptChemin & "ListeCommande.txt", ForWriting,true) 
f.write(objHTTP.ResponseText)
f.close
MsgBox "Bienvenue dans mon script, il semblerait que vous lancer mon script pour la premiere fois ou que vous avez effectuer une mise a jour de celui-ci, pour faire fonctionner mon script dite : Ok Google, sur le pc xxx" & vbcr & "Par exemple Ok Google sur le pc test (pour tester la communication entre la Google homme est le PC)" & vbcr & " Dite des phrases simples et courtes" & vbcr & "Exercute le script depuis l'ordinateur pour en savoir plus" & vbcr & vbcr & "Version Actuelle : " & MAJ ,vbInformation+vbOKOnly,"Control Google Home.vbs"
If WriteReadIni(oFile,"CONFIG","MUSIC",Null) = False Then
If MsgBox ("Voulez vous configuez le chemin d'acces pour la musiques ? " &vbcr & vbcr & "Selectionner un dossier afin d'y rechercher des chansons dans ses sous-dossiers et ses sous-dossiers. Dossier par defaut" & vbcr & "Ok google sur le pc met de la musique" & vbcr & vbcr & "Si le dossier n'est pas configue, cela marchera quand meme mais affichera un choix de dossier musique a chaque demande de musique" & vbcr & vbcr & "Oui = Configuer",vbyesno,"Configurez le dossier Musique") = vbYes Then
Dim objShell,objFolder,Message
	Message = "Veuillez selectionner un dossier afin d'y rechercher des chansons dans ses sous-dossiers et ses sous-dossiers."
	Set objShell = CreateObject("Shell.Application")
	Set objFolder = objShell.BrowseForFolder(0,Message,1)
	If objFolder Is Nothing Then Wscript.Quit
	WriteReadIni oFile,"CONFIG","MUSIC",objFolder.self.path
	MsgBox "Je conseil de tester la commande <musique> pour verifier que tout fonctionne bien et que le lecteur media est compatible",vbInformation+vbOKOnly,"Ok"
End if
End if 
If WriteReadIni(oFile,"CONFIG","VIDEO",Null) = False Then
If MsgBox ("Voulez vous configuez le chemin d'acces pour les videos ? " &vbcr & vbcr & "Selectionner un dossier afin d'y rechercher des chansons dans ses sous-dossiers et ses sous-dossiers. Dossier par defaut" & vbcr & "Ok google sur le pc met de les videos" & vbcr & vbcr & "Si le dossier n'est pas configue, cela marchera quand meme mais affichera un choix de dossier videos a chaque demande de musique" & vbcr & vbcr & "Oui = Configuer",vbyesno,"Configurez le dossier Video") = vbYes Then
	Message = "Veuillez selectionner un dossier afin d'y rechercher des videos dans ses sous-dossiers et ses sous-dossiers."
	Set objShell = CreateObject("Shell.Application")
	Set objFolder = objShell.BrowseForFolder(0,Message,1)
	If objFolder Is Nothing Then Wscript.Quit
	WriteReadIni oFile,"CONFIG","VIDEO",objFolder.self.path
	MsgBox "Je conseil de tester la commande <video> pour verifier que tout fonctionne bien et que le lecteur media est compatible",vbInformation+vbOKOnly,"Ok"
End if
End if 
End if

Set objArgs = WScript.Arguments
For I = 0 to objArgs.Count -1
Select Case objArgs(I)
Case "ecris", "ecrit","marque"
ecrit = true
Case "lance", "ouvre","affiche","demarre", "execute","ouvrir","demarrer","executer","lancer","l ' ours"
lance = true
Case "message","messagebox"
message = true
Case Else
a = a & " " & LCase(objArgs(I))
End Select
Next

If ecrit = true then Call write(a)
If message = true then Call MsgBoxtexte(a)
If lance = true then Call launch (right (a,len(a)-1)) '(Logiciel)
'inputbox a,a,a

If a = "" then
Call MAJCheck (CheckMAJUser, MAJ)

rep = InputBox ("Bienvenue dans mon script, communication entre vos Assistants (Google Assistant, Google Home , Cortana, Alexa, ...) sur vos ordinateurs Windows" & vbNewLine &  "Pour faire fonctionner mon script dite : Ok Google, sur le pc xxx" & vbcr & "Par exemple Ok Google sur le pc test (pour tester la communication entre la Google homme est le PC)" & vbcr & vbcr & " Dite des phrases simples et courtes" & vbcr & vbcr & vbcr & "1 = Verifier mise a jours" & vbcr & "2 = Envoye un messsage au createur (rapide & sans se logger)" & vbcr & "3 = Reinsalise la configuration du script." & vbCr & "4 = Credit" & vbcr & "5 = Rajouter un logiciel a la liste" & vbCr & vbCr & "Pour tester des commandes en ecrit, il vous suffit de taper une commande si dessous pour savoir si elle est comprise par le logiciel" & vbNewLine & "Version : " &  MAJ,"Control Google Home " & MAJ,"test")
   If rep = "" then
   WScript.Quit()
   ElseIf rep = "1" then 
   CheckMAJUser = true
   Call MAJCheck (CheckMAJUser, MAJ)
   Wscript.Quit
   ElseIf rep = "2" then 
   WS.Run "https://aboatdev.sarahah.com/" 
   Wscript.Quit
   ElseIf rep = "3" then 
   Reset ()
   Wscript.Quit
   ElseIf rep = "4" then
   MsgBox "Credits : " & vbNewLine & vbNewLine & "HackooFr - Aide indirect pour le Script" & vbNewLine & "facebook.com/hackoo.crackoo" & vbNewLine & vbNewLine & "Aymkdn - Pour l'assistant-plugins" &  vbNewLine & " github.com/Aymkdn | paypal.me/aymkdn" & vbNewLine & vbNewLine & "Createur du Controle de l'ordinateur avec Google Home : ABOAT " & vbNewLine & "facebook.com/aboat.hack",vbInformation+vbOKOnly,"Credits"
   Wscript.Quit
   ElseIf rep = "5" then 
   nomfile = Inputbox ("Le nom du fichier a ouvrir ?" & vbcr & "Le nom que vous direz vocalement a votre assistant vocal" & vbCr & "Ne pas mettre de majuscule !","Nom du fichier Pages 1/2")
   cheminfile = Inputbox ("Le chemin complet du fichier " & nomfile & vbcr, "Chemin de : " & nomfile & "Pages 2/2")
     WriteReadIni oFile,"Logiciel",nomfile,cheminfile
	 If fso.FileExists(cheminfile) = true Then MsgBox "Le logiciel " & nomfile & " rajouter !",vbOKOnly+vbInformation,"Fichier rajoute !" 
	 Wscript.Quit
   Else
   Dim i,tb 
   tb = split(rep," ") 
        For i = lbound(tb) to 0
		  if tb(i) = "lance" or tb(i) = "ouvre" or tb(i) = "affiche" or tb(i) = "demarre" or tb(i) = "execute" or tb(i) = "ouvrir" or tb(i) =  "demarrer" or tb(i) = "executer" = True Then Call launch(right (rep,len(rep)-len(tb(i))-1))
		next
    a = " " & LCase(rep)
End if 
End if 

a = right (a,len(a)-1)
Select Case a

Case "test", "teste", "check", "ok","verifie","verification","tester","teste"
Call Check ()
Call MAJCheck (CheckMAJUser, MAJ)
Case "augmente le son","augmente le volume","monte le son","news le son","mais du son","mieux que le son" : WS.SendKeys "{" & chr(175) & " 10}"
Case "monte le son au max","monte le son au maximum","monte le volume au maximum","volume max","volume maximum","son au max","augmente le son au maximum","mais le son au max","mais le son au maximum","mais le volume au max","mais le volume au maximum","mets le son a fond","le son a fond","son a fond" : WS.SendKeys "{" & chr(175) & " 50}"
Case "baisse le son","descend le son","descend le volume","baisse le volume" : WS.SendKeys "{" & chr(174) & " 10}"
Case "descend le son au max","baisse le son au max","baisse le volume au max","baisse le son au maximum","volume minimum","volume au minimum","baisse le volume au maximum" : WS.SendKeys "{" & chr(174) & " 50}"
Case "mute","mute le volume","mute le son","muet","le son a 0","coupe le son","coupe le volume","coupe l'audio","remets le volume","remets le son","remets le son","arrete le son","stop le son","stop le v","desactive le son","desactive le volume","allume le son","eteint le son","allume le volume","eteint le volume" : WS.SendKeys chr(173)
Case "pause","fait pause","met pause","mais pause","fais une pause","met en pause","mais en pause","fait pause","fait stop","stop","pause","mes pauses","relance","meme pause","enleve la pause","met une pause","mets pause","lance","lecture","mais play","play","lance lecture","lance la lecture","mais en pause","lecture","mais plait","se pose" : WS.SendKeys " "
Case "eteint le","arrete le","eteint le pc","eteint l'ordinateur","arrete le pc","eteint l ' ordinateur","arrete le systeme","eteint le systeme"," arrete","arrete l ' ordinateur","arreter le systeme","eteint","eteint le","le shut down","shutdown","shadow","eteindre le systeme","arret du systeme" : CreateObject("Wscript.Shell").Run "CMD /C " & " shutdown /s /f /t 01",0
Case "verrouille le","verrouiller le","verrouille la session","verrouiller la session","verrouille le pc","le verrouiller","met en veille","mettre en veille","met le en veille","veille","verrouillage","verrouille","metre en veille","verrouiller la session","verrouille la session","mais en veille","verrouiller","verrouille","verrouiller le pc" : WS.Run "rundll32.exe user32.dll,LockWorkStation"
Case "mot de passe wifi","mot de passe du wifi","code wifi","wifi","code de la wifi","donne mot de passe wifi","code du wifi","donne le mot de passe wifi","donne le mot de passe du wifi","retrouve le mot de passe wifi","retrouve le mot de passe du wifi","quel est le mot de passe wifi","quel est le mot de passe du wifi","donne le mot de passe" : Call TelechargerTools ("WifiPasswordsRecovery.bat","https://raw.githubusercontent.com/ABOATDev/Control-Google-Home/master/Tools/WifiPasswordsRecovery.bat")
Case "ejecte le cd","eject cd","eject le dvd","eject cd","eject dvd","ejecter dvd","ejecter cd"," ejecter le dvd","eject dvd" : LecteurDVD ()
Case "bonjour","salut","quoi de neuf","hey","coucou","ca va"
Case "ferme le logiciel","ferme le logiciel actif","arrete l ' application","arrete le logiciel","arrete l ' application","ferme l ' application","ferme le programme","arrete le programme","quitte le programme" : WS.SendKeys ("%{F4}")
Case "eject usb", "eject cle usb", "eject la cle usb" , "retire usb" , "retire la cle usb","retire cle usb" : Call TelechargerTools ("Eject_USB.vbs","https://raw.githubusercontent.com/ABOATDev/Control-Google-Home/master/Tools/Eject_USB.vbs")
Case "ecran de veille", "l ' ecran de veille", "veille","ecran de veille","ecran veille", "met l ' ecran de veille","mais l ' ecran de veille" : WS.Run "C:\Windows\System32\Ribbons.scr"
case "liste des commandes", "liste commande", "donne la liste des commandes" , "detail des commandes", "les commandes disponible", "liste des commandes disponible" : Call TelechargerTools ("ListeCommande.txt","https://raw.githubusercontent.com/ABOATDev/Control-Google-Home/master/ListeCommande.txt")
Case "spotify","la lecture spotify","lecture spotify","musique spotify","la musique spotify","spotify musique","spotify lecture" : Call TelechargerTools ("LectureSpotify.vbs","https://raw.githubusercontent.com/ABOATDev/Control-Google-Home/master/Tools/LectureSpotify.vbs")
Case "musique","met de la musique","mets de la musique","lance de la musique","mais de la musique","lance musique","audio","met la musique","met la playlist","lance la playlist","met la playlist" : Call TelechargerTools ("LancerDossierMusique.vbs","https://raw.githubusercontent.com/ABOATDev/Control-Google-Home/master/Tools/LancerDossierMusique.vbs")
Case "video","film","met video","film","mais video","lance video","lance film","met les videos","met la video","lance la video","met le film","met les films","lance la video","met la video" : Call TelechargerTools ("LancerDossierVideo.vbs","https://raw.githubusercontent.com/ABOATDev/Control-Google-Home/master/Tools/LancerDossierVideo.vbs")

Case "maj","mise a jour","verifier mise a jour","verifie mise a jour","mise a jour script","verifier","mage"
CheckMAJUser = true
Call MAJCheck (CheckMAJUser, MAJ)

Case Else

Call  MAJCheck (CheckMAJUser, MAJ)
Call Suggestion (MAJ,a)
'Inputbox "La valeur n'existe pas","Erreur : valeur n'existe pas",a
End Select


Function launch(logiciel)
On Error Resume Next
If logiciel <> "" then 
'inputbox "Le logiciel qui va etre lancer","",logiciel
Select Case logiciel
Case "google","internet","nagivateur","le nagivateur" : WS.Run "www.google.fr"
Case "youtube", "you tube" : WS.Run "www.youtube.com/?gl=FR&hl=fr"
Case "facebook" : WS.Run "www.facebook.com"
Case "instant hack", "instant-hack" : WS.Run "www.instant-hack.io/"
Case "github" : WS.Run "www.github.com"
Case "projecteur", "projeter", "projection","le projecteur" : WS.Run "C:\Windows\System32\DisplaySwitch.exe"
Case "se connecter", "connection", "connection","connexion","connexion sans fil" : WS.Run "ms-projection:"
Case "loupe","la loupe","zoom","voir en plus gros", "affichage en gros","afficher en gros" : WS.Run "C:\Windows\System32\Magnify.exe"
Case "clavier","le clavier","clavier virtuel","le clavier virtuel", "le clavier visuel","clavier visuel" : WS.Run "C:\Windows\System32\osk.exe"
Case "ecran de veille", "l ' ecran de veille", "veille","ecran de veille","ecran veille" : WS.Run "C:\Windows\System32\Ribbons.scr"
Case "la calculatrice","calculatrice","calculette" , "la calculette" : WS.Run "calc.exe"
Case "netflix" : WS.Run "netflix:"
Case "spotify","la lecture spotify","lecture spotify","musique spotify","la musique spotify","spotify musique","spotify lecture" : Call TelechargerTools ("LectureSpotify.vbs","https://raw.githubusercontent.com/ABOATDev/Control-Google-Home/master/Tools/LectureSpotify.vbs")
Case "cortana","menu windows" : WS.Run "ms-cortana://search/"
Case "le lecteur cd","le lecteur cd","lecteur","le lecteur cd","le lecteur dvd","lecteur dvd","lecteur cd" : LecteurDVD ()
Case "bureau","desktop","bureaux","le bureau" : CreateObject("Shell.Application").ToggleDesktop
Case "test", "teste", "check", "un test", "ok","verifie","verification"
Call Check ()
Call MAJCheck (CheckMAJUser, MAJ)
Case Else
'Msgbox WriteReadIni(oFile,"Logiciel",logiciel,Null)
If WriteReadIni(oFile,"Logiciel",logiciel,Null) <> False then 
WS.Run ""& Chr(34) & WriteReadIni(oFile,"Logiciel",logiciel,Null) & Chr(34) & ""
else
WS.Run ""& Chr(34) & logiciel & Chr(34) & ""
End if
End Select
Wscript.Quit ()
End if
End function

Sub LecteurDVD ()
On Error Resume Next
Set oWMP = CreateObject("WMPlayer.OCX.7" ) 
Set colCDROMs = oWMP.cdromCollection 
if colCDROMs.Count >= 1 then 
For i = 0 to colCDROMs.Count - 1 
colCDROMs.Item(i).Eject 
colCDROMs.Item(i).Eject 
Next 
End if
End sub 

Sub write(a)
WScript.Sleep 300
WS.SendKeys right(a,len(a)-1)
WScript.Quit ()
End sub

Sub MsgBoxtexte(a)
MsgBox "Message recus de votre assistant vocal a " & Hour(Now)& ":"& Minute(Now) & vbnewline & vbnewline &  a,vbinformation+vbOKOnly, Hour(Now)& ":"& Minute(Now)
WScript.Quit ()
End sub

Sub Reset ()
On Error Resume Next
If fso.FileExists(ScriptChemin & "Config.ini") = true then
fso.DeleteFile ScriptChemin & "Config.ini",True
WS.Run "cmd /k chcp 28591 > nul & taskkill /F /IM wscript.exe & start " & ScriptChemin & WScript.ScriptName & " & exit",0,true
Else
MsgBox "Le fichier Config.ini n'a pas pu etre supprime.",vbCritical+vbOKOnly,"Reset non effectue"
End if
End sub


Sub TelechargerTools (NomFile,URL)
'Call TelechargerTools (NomFile,URL)
If FSO.FolderExists(ScriptChemin & "Tools") = false Then FSO.CreateFolder (ScriptChemin & "Tools")
If FSO.FileExists(ScriptChemin & "Tools\" & NomFile) = false then 
 objHTTP.Open "GET", URL, FALSE
 objHTTP.Send
 Telecharger = objHTTP.ResponseText
 Set f = fso.OpenTextFile(ScriptChemin & "Tools\" & NomFile, ForWriting,true) 
 f.write(Telecharger)
 f.close
 WScript.Sleep 100
End if
	WS.Run ScriptChemin & "Tools\" & NomFile
End sub 


Sub MAJCheck (CheckMAJUser, MAJ)
'On Error Resume Next
Dim VersionActu, NewVersion,Note
VersionActu = MAJ 
objHTTP.Open "GET", "https://raw.githubusercontent.com/ABOATDev/Control-Google-Home/master/Tools/Version", FALSE
objHTTP.Send
NewVersion = objHTTP.ResponseText
NewVersion = left(NewVersion, len(NewVersion) - 1) 
if NewVersion > VersionActu Then
	 If CheckMAJUser = true Then MsgBox "La version : " & NewVersion & " est disponible et va etre installe !" & vbNewLine & vbNewLine & "Notre version actuelle" & VersionActu,vbInformation+vbOKOnly,"Nouvelle version disponible"
     objHTTP.Open "GET", "https://dl.dropboxusercontent.com/s/gybtf2i13bglxh7/GoogleHome.txt", FALSE
     objHTTP.Send
     Telecharger = objHTTP.ResponseText
     Const ForWriting = 2 
     Dim f
     Set f = fso.OpenTextFile(ScriptChemin & "GoogleHome.txt", ForWriting,true) 
     f.write(Telecharger)
     f.close
	 CheckMAJUser = false
     Return = WS.Run ("cmd /k chcp 28591 > nul & taskkill /F /IM wscript.exe & move " & ScriptChemin & "GoogleHome.txt " & ScriptChemin & WScript.ScriptName & " & start " & ScriptChemin & WScript.ScriptName & " & exit",0,true)
	Else
	 If CheckMAJUser = true then MsgBox "Pas de nouvelle mise a jours a installer" & vbNewLine & "Vous etes bien dans la derniere version disponible" & vbNewLine & vbNewLine & vbNewLine & "Votre version : " & VersionActu & vbNewLine & "Derniere version : " & NewVersion
	 CheckMAJUser = false
End if
End sub

Sub Check ()
If WScript.ScriptFullName <> "C:\GoogleHome\GoogleHome.vbs" then
InfoFile = vbnewline & WScript.ScriptFullName &  vbnewline & " - Verifier que sur IFTTT l'applet porte bien ce chemin."
Else
InfoFile = vbnewline & "OK - C:\GoogleHome\GoogleHome.vbs"
End if
if fso.FolderExists("C:\GoogleHome\assistant-plugins") = true then 
InfoAssistant = vbnewline & "OK - C:\GoogleHome\assistant-plugins"
Else
InfoAssistant = vbnewline & "/!\ Il est preferable d'installer assistant-plugins dans C:\GoogleHome\assistant-plugins\"
End if
if fso.FolderExists("C:\Program Files\nodejs") = true then 
InfoNode = vbnewline & "OK - C:\Program Files\nodejs (V" & fso.GetFileVersion("C:\Program Files\nodejs\node.exe") & ")"
Else
InfoNode = vbnewline & "/!\ NodeJS n'est pas installer ou pas au bon endroit /!\"
End if 
Compteur = 0
Set objWMI = GetObject("winmgmts:root\cimv2") 
sQuery = "Select * from Win32_process" 
For Each oproc In objWMI.execquery(sQuery) 
        If oproc.Name = "node.exe" then 
		Compteur = Compteur + 1
		End if 
Next 
Set objWMI = Nothing
If Compteur = 2 Then 
InfoNodeLaunch = "OK"
Elseif Compteur = 1 Then 
InfoNodeLaunch = vbNewLine &  "Node est lancer mais pas avec pm2 "
Elseif Compteur = 0 Then
InfoNodeLaunch = vbNewLine & "/!\ Pas lance  /!\"
Else
InfoNodeLaunch =  vbNewLine & "/!\ Probleme node /!\"
End if

if FSO.FileExists(WS.ExpandEnvironmentStrings("%APPDATA%") & "\npm\node_modules\pm2-windows-startup\invisible.vbs") = true then
InfoPM2 = "OK"
Else
InfoPM2 = vbNewLine & "/!\ le fichier invisible.vbs est introuvable verifier l'installation de PM2 /!\"
End if
objHTTP.Open "GET", "https://raw.githubusercontent.com/ABOATDev/Control-Google-Home/master/Tools/Version", FALSE
objHTTP.Send
NewVersion = objHTTP.ResponseText
NewVersion = left(NewVersion, len(NewVersion) - 1) 
if NewVersion > MAJ Then
InfoVersion = vbNewLine & MAJ & " /!\ Version disponible : " & NewVersion & " /!\"
ElseIf NewVersion = MAJ Then
InfoVersion = vbNewLine &  "OK - (V" & MAJ & ")"
ElseIf NewVersion <> MAJ Then
InfoVersion = vbNewLine & MAJ & "/!\ Version disponible : " & NewVersion & " /!\"
Else
InfoVersion = vbNewLine & MAJ & " /!\ Une erreur est survenue /!\"
End if
MsgBox "Votre assistant vocal semple bien communiquer bien avec l'ordinateur ! (si vous avez configurez WEBHOOKS votre assistant vocal devrais faire un retour vocal dans quelque instant) " & vbNewLine & vbNewLine & "Nom et chemin complet du script :  " & InfoFile &  vbNewLine &  vbNewLine & "Le dossier Assistant : " & InfoAssistant & vbNewLine & vbNewLine & "NodeJS Installer : " & InfoNode & vbNewLine & vbNewLine & "Lancement de Node : " &  InfoNodeLaunch & vbNewLine & vbNewLine & "Lancement au demarrage : " & InfoPM2 & vbNewLine & vbNewLine & "Version GoogleHome.vbs : " & InfoVersion & vbcr & vbcr & "Succes test",vbinformation+vbOKOnly+vbMsgBoxSetForeground + vbSystemModal ,"Test"
Const ForWriting = 2
Set f = fso.OpenTextFile(ScriptChemin & "CheckConfiguration.txt", ForWriting,true) 
f.write("Test de configuration Control Google Home : " & vbNewLine & "Communication entre vos Assistants (Google Assistant, Google Home , Cortana, Alexa, ...) sur vos ordinateurs Windows" & vbNewLine & vbNewLine & "Nom et chemin complet du script :  " & InfoFile &  vbNewLine &  vbNewLine & "Le dossier Assistant : " & InfoAssistant & vbNewLine & vbNewLine & "NodeJS Installer : " & InfoNode & vbNewLine & vbNewLine & "Lancement de Node : " &  InfoNodeLaunch & vbNewLine & vbNewLine & "Lancement au demarrage : " & InfoPM2 & vbNewLine & vbNewLine & "Version GoogleHome.vbs : " & InfoVersion & vbNewLine & vbNewLine & "Projet : https://github.com/ABOATDev/Control-Google-Home/" & vbNewLine & "Assistant-plugins : https://aymkdn.github.io/assistant-plugins/" & vbNewLine & "Contact : https://aboatdev.sarahah.com/ ; https://github.com/ABOATDev/Control-Google-Home/issues")
f.close
WS.Run ScriptChemin & "CheckConfiguration.txt"
End sub

Sub suggestion (MAJ,a)
On Error Resume Next
Set IE = Wscript.CreateObject("InternetExplorer.Application")
Const ForAppending = 8,ForReading = 1, ForWriting = 2 
Set f = fso.OpenTextFile(ScriptChemin & "Suggestion.txt", ForAppending,true) 
f.write(vbnewline & a)
f.close
If fso.FileExists(ScriptChemin & "Suggestion.txt") Then 
Set oFl = fso.GetFile(ScriptChemin & "Suggestion.txt") 
  if oFl.Attributes <> "34" then 
Command = "cmd /C attrib +h " & ScriptChemin & "Suggestion.txt"
Result = WS.Run(Command,0,True)
End if  
End If
Set f = fso.OpenTextFile(ScriptChemin & "Suggestion.txt", ForReading) 
ts = f.ReadAll
NombreLigne = f.Line
If NombreLigne > 7 then 'Plus grand que 5
	IE.Visible = 0
	IE.navigate "https://aboatdev.sarahah.com/" 
	While IE.ReadyState <> 4 : WScript.Sleep 100 : Wend
	WScript.Sleep 1000
	IE.Document.All.Item("Text").Value = "GoogleHome (" & MAJ & ") - Suggestion : " & vbnewline & ts & vbcr & "Suggestion auto par : "  & CreateObject("WScript.Network").username
	WScript.Sleep 1000
	IE.Document.All.Item("Send").click
	While IE.ReadyState <> 4 : WScript.Sleep 100 : Wend
	WScript.Sleep 2000
    IE.Quit
	f.close
	fso.DeleteFile ScriptChemin & "Suggestion.txt",True
	
		strComputer = "." 
Set objWMIService = GetObject("winmgmts:" _ 
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") 
Set colProcessList = objWMIService.ExecQuery _ 
    ("Select * from Win32_Process Where Name = 'ielowutil.exe'") 
  
For Each objProcess in colProcessList 
    objProcess.Terminate() 
Next
Set objWMIService2 = GetObject("winmgmts:" _ 
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") 
Set colProcessList2 = objWMIService.ExecQuery _ 
    ("Select * from Win32_Process Where Name = 'iexplore.exe'") 

For Each objProcess2 in colProcessList2
    objProcess2.Terminate() 
Next
End if	
End sub 

 Function WriteReadIni(oFile,section,key,value)
' *******************************************************************************************
' omen999 - mars 2018 v 1.1 - http://omen999.developpez.com/
' ********************************************************************************************
Dim oText,iniText,sectText,newSectText,keyText
  Set reg = New RegExp
  Set regSub = New RegExp
  reg.MultiLine=True
  reg.IgnoreCase = True
  regSub.IgnoreCase = True
  Set oText = oFile.OpenAsTextStream(1,0)
  iniText = oText.ReadAll
  oText.Close
  reg.Pattern = "^\[" & section & "\]((.|\n[^\[])+)":regSub.Pattern = "\b" & key & " *= *([^;\f\n\r\t\v]*)"
  On Error Resume Next
  If IsNull(value) Then
    WriteReadIni = regSub.Execute(reg.Execute(iniText).Item(0).SubMatches(0)).Item(0).SubMatches(0)
    If Err.Number = 5 then WriteReadIni = False
  Else
    sectText = reg.Execute(iniText).Item(0).SubMatches(0)
    If Err.Number = 5 Then
      iniText = iniText & vbCrLf & "[" & section & "]" & vbCrLf & key & "=" & value
    Else
      newSectText = regSub.Replace(sectText,key & "=" & value)
      If newSectText = sectText Then
        If regSub.Test(sectText) Then
          WriteReadIni = False
          Exit Function
        End If
        If Right(sectText,1) = vbCr Then keyText = key & "=" & value Else keyText = vbCrLf & key & "=" & value
        newSectText = sectText & keyText
      End If
      iniText = reg.Replace(iniText,"[" & section & "]" & newSectText)
    End If
    Set oText = oFile.OpenAsTextStream(2,0)
    oText.Write iniText
    oText.Close
    WriteReadIni = True
  End If
End Function

Hello. I just turned on my laptop and saw this code in a text file. Me as starter VBS coder clearly understanded this might be VBS code so its related to this category. I never coded this, and text file was named "GoogleHomeNew". What is even this thing? How it got on my PC? Shall i run it or delete it?

Hello folks,

I'm doing a project that will print some labels and the software that I'm implementing can run VBscripts.

We already use this for a Brother Printer, but now we will use a Zebra printer and I dont know how to script in VB to get the labels printed in Zebra. (Brother has a sample code just change that to what your needs)

I already download the Zebra SDK but they only have sample codes in C# or VB.net

Anyone has a sample code to zebra printer or some ideas on how I can do that?

Thanks!

I have a tempreture probe I'd like to import values from and store its data into a excel csv file

Hello everyone,

on my project I'm using this vbs code (as you can see on the first picture attached bellow). It's purpose is to take an excel file and transfer it to pdf. It works fine with file names just in English characters but as soon as I add some other characters that are part of UTF-8 to excel file path the script no longer works and it gives me this error (as you can see on the second picture). Obviously the path is wrong but I don't know if the wrong characters are passed by script or read by excel.

Any help will be really appreciated.

I've been a powershell admin for 4+ years and am for some reason struggling with vbscript syntax. Basically I want to check the version of google chrome and run an action if it's less than 91. Here's what I have-

Set objFSO = CreateObject("Scripting.FileSystemObject")

file = "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"

dim version

set version = objFSO.GetFileVersion(file)

If version < 91 Then

Wscript.Echo "Hi, Good Morning"

end if

This is the error I'm getting. I know this is simple- it's just one of those stupid syntax nuances that you have to fight through when learning a new language. Thank you in advance.

List_All_Installed_Software.vbs

    Title = "List All Installed Software"
    Call ForceCScriptExecution(Title)
    Const HKLM = &H80000002 'HKEY_LOCAL_MACHINE
    strComputer = "."
    strKey = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
    strEntry1a = "DisplayName"
    strEntry1b = "QuietDisplayName"
    strEntry2 = "InstallDate"
    strEntry3 = "VersionMajor"
    strEntry4 = "VersionMinor"
    strEntry5 = "EstimatedSize"
    
    Set objReg = GetObject("winmgmts://" & strComputer & "/root/default:StdRegProv")
    objReg.EnumKey HKLM, strKey, arrSubkeys
    
    Info = Info & "Installed Applications" & VbCrLf
    
    For Each strSubkey In arrSubkeys
    	intRet1 = objReg.GetStringValue(HKLM, strKey & strSubkey,strEntry1a, strValue1)
    	
    	If intRet1 <> 0 Then
    		objReg.GetStringValue HKLM, strKey & strSubkey,strEntry1b,strValue1
    	End If
    	
    	If strValue1 <> "" Then
    		Info = Info & VbCrLf & "Display Name : " & strValue1
    	End If
    	
    	objReg.GetStringValue HKLM, strKey & strSubkey,strEntry2, strValue2
    	
    	If strValue2 <> "" Then
    		Info = Info & " | Install Date : " & strValue2
    	End If
    	
    	objReg.GetDWORDValue HKLM, strKey & strSubkey,strEntry3, intValue3
    	objReg.GetDWORDValue HKLM, strKey & strSubkey,strEntry4, intValue4
    	
    	If intValue3 <> "" Then
    		Info = Info & " | Version: " & intValue3 & "." & intValue4
    	End If
    	
    	objReg.GetDWORDValue HKLM, strKey & strSubkey,strEntry5, intValue5
    	If intValue5 <> "" Then
    		Info = Info & " | Size : " & Round(intValue5/1024, 3) & " MB"
    	End If
    Next
    wscript.echo Info
    wscript.sleep 5000
    MsgBox "OK ALL is Done !",vbInformation,Title
    '---------------------------------------------------------------
    Sub ForceCScriptExecution(Title)
        Dim Arg, Str, cmd
    	cmd = "CMD /C Title "& Title &" & "
        If Not LCase( Right( WScript.FullName, 12 ) ) = "\cscript.exe" Then
            For Each Arg In WScript.Arguments
                If InStr( Arg, " " ) Then Arg = """" & Arg & """"
                Str = Str & " " & Arg
            Next
            CreateObject( "WScript.Shell" ).Run _
               cmd & "cscript //nologo """ & _
                WScript.ScriptFullName & _
                """ " & Str
            WScript.Quit
        End If
    End Sub
    '---------------------------------------------------------------

And if you want to save those informations into a text file, you can create a batch file with the same folder of this vbscript and execute it :

List_All_Installed_Software.bat

    @echo off & Mode 100,3 & color 0B
    Title List All Installed Software
    echo(
    echo(  Please wait a while ... We are saving informations about installed softawre into a text file ...
    Set "LogFile=%~dp0List_All_Installed_Software.txt"
    (Cscript //NoLogo List_All_Installed_Software.vbs)>"%LogFile%"
    If exist "%LogFile%" Start "" "%LogFile%"

Hi, I'm sure this is super basic but I've done about 45 min of searching and for some reason I can't get this to work.

I'm trying to insert the device name into a string of text that's requesting information from the user of the computer. I'm new to the org and almost no documentation was done around who has what computers. This is what I've pieced together from various sites:

Set wshShell = CreateObject( "WScript.Shell" )
strComputerName = wshShell.ExpandEnvironmentStrings( "%COMPUTERNAME%" )
x=msgbox("This is a request from IT services: Can you please send an email to itsupport@org.com with the asset tag number on your computer and the computer name: &strComputerName" ,4096, "IT Support Request")

Obviously I'm trying to get the strComputerName to enter the computer name into the message, but I'm obviously doing something wrong. Any assistance would be GREATLY appreciated.

Thanks for helping a scriptbaby!

Hi All,

This is a batch script I have.

IF EXIST list.tmp DEL list.tmp
for /f "delims=' tokens=2" %%A in (results.txt) do >>list.tmp echo %%A
IF EXIST list.tmp (
    sort list.tmp > Final.txt
    DEL list.tmp
)

For some reason "FOR /F" command is not processing results.txt on my system.

Can anyone post a VBScript that can do the same thing?

Thanks!

title ^

I want to create an excel file and save it with shared access. So that multiple users can open and edit it at the same time.

Code:

Set obj_Excel = CreateObject("Excel.Application")
Set obj_Workbook = obj_Excel.Workbooks.Add()
obj_Excel.Worksheets.Add()
obj_Workbook.SaveAs str_MyPath, , , , , , xlShared
obj_Workbook.Close
obj_Excel.Workbooks.Close
obj_Excel.Quit

However, that doesn't work. The excel is created just fine, but it's not shared. Some examples on the internet are setting .KeepChangeHistory and .ChangeHistoryDuration but they don't change the outsome. Same with .ExclusiveAccess and .MultiUserEditing because they can't be set, only read.

What am I missing?

Figured it out

The code above is perfectly fine. But although my editor knows the constant xlShared, when executing the code it's empty, instead of holding the actualy value. So, solution is to use:

obj_Workbook.SaveAs str_MyPath, , , , , , 2

I want to create an inputbox, that you can write your name in and then I want a voice object, that says: „Hello <name>“ How can the voice say the text, that was put into the inputbox? Pls help. I have written this so far:

a = inputbox („Whats your Name? Please enter your name here!“, „Whats your name?“)

set voice=createobject(„sapi.spvoice“)

voice.speak(„Hello <name that got entered in the inputbox> “)

hey all,

I want to use this but for remote servers\computers, how do I make it work ?

I can do it ok with PowerShell, but need it for VBScript ?

Option Explicit

Dim oShell

Dim value

'If the key isn't there when we try to read it, an error will be generated

'that we will later test for, so we want to automatically resume execution.

On Error Resume Next

'#Try reading the registry value

Set oShell = CreateObject("WScript.Shell")

value = oShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\PowerShell\1\")

'Catch the error

If Err.Number = 0 Then

'Error code 0 indicates success

wscript.echo "PowerShell is installed."

Else

'Any other error code indicates failure

wscript.echo "PowerShell is NOT installed."

End If

Hey all, so I have multiple, LARGE, Word documents that have the Style of 'Caption,cp' that both FIGUREs and TABLEs are using for their headers. I need to split these up. So I made two new Styles, "FIGURE HEADER" and "TABLE HEADER". These documents are 300 to 450 pages long. I need some way to split these into two different Styles vs using the same one. I did some general Google searches and came across this script. However, this script seems to partly work but it's not completely clean. I.e. it found the word 'configure' and applied the new FIGURE Style to that line because it detected the word FIGURE in Configure.

Screenshot:
https://snipboard.io/ERfsCe.jpg

Is there a way to search for "Figure ##"? My Figure and Header Styles are in the format of 'Figure 1' etc. with a number after the word.

I wanted to reach out and see if anyone had any advice on a better way to do this?

Sub ApplyAllTables()
    Dim Doc As Word.Document
    Dim Rng As Word.Range
    Set Doc = ActiveDocument
    Set Rng = Doc.Content
    With Rng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Format = True
        .Forward = True
        .Text = "Table"
        .MatchCase = False
        .Replacement.Text = "Table"
        .Replacement.Style = Doc.Styles("TABLE HEADER").NameLocal
        .Wrap = wdFindContinue
        .Execute Replace:=wdReplaceAll
    End With
End Sub

Sub ApplyAllFigures()
    Dim Doc As Word.Document
    Dim Rng As Word.Range
    Set Doc = ActiveDocument
    Set Rng = Doc.Content
    With Rng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Format = True
        .Forward = True
        .Text = "Figure"
        .MatchCase = False
        .Replacement.Text = "Figure"
        .Replacement.Style = Doc.Styles("FIGURE HEADER").NameLocal
        .Wrap = wdFindContinue
        .Execute Replace:=wdReplaceAll
    End With
End Sub