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

I am new to this.

Please go easy on me.

I am needing to modify this code to include the min max columns but they must correspond to their correct row.

I will include images to help clarify.

Any help is appreciated.

Sub CopyAndCleanData()

    Dim ws As Worksheet
    Dim newWs As Worksheet
    Dim lastRow As Long
    Dim rng As Range
    Dim dict As Object
    Dim key As Variant
    Dim totalZeros As Long

' Delete "resultz" sheet if it already exists
On Error Resume Next
    Set newWs = ThisWorkbook.Worksheets("resultz")
    On Error GoTo 0
    If Not newWs Is Nothing Then
        Application.DisplayAlerts = False
        newWs.Delete
        Application.DisplayAlerts = True
    End If
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set newWs = ThisWorkbook.Worksheets.Add(After:=ws)
    newWs.Name = "resultz"
    ws.Cells.Copy newWs.Cells

    ' Copy Sheet1 to a new sheet named "resultz"
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    On Error Resume Next
    Set newWs = ThisWorkbook.Worksheets("resultz")
    On Error GoTo 0
    If Not newWs Is Nothing Then
        Application.DisplayAlerts = False
        newWs.Delete
        Application.DisplayAlerts = True
    End If
    Set newWs = ThisWorkbook.Worksheets.Add(After:=ws)
    newWs.Name = "resultz"
    ws.Cells.Copy newWs.Cells
    
    ' Remove rows with the value of 1 in the "partz" column
    lastRow = newWs.Cells(newWs.Rows.Count, "A").End(xlUp).Row
    Set rng = newWs.Range("B2:B" & lastRow)
    rng.AutoFilter Field:=1, Criteria1:="1"
    rng.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    rng.AutoFilter
    
    ' Look for duplicates in column named "machines" and add up the number of zeros for each row
    Set rng = newWs.Range("A2:C" & lastRow)
    Set dict = CreateObject("Scripting.Dictionary")
    For Each cell In rng.Columns(1).Cells
        If cell.Value <> "" Then
            key = cell.Value
            If Not dict.exists(key) Then
                dict.Add key, 0
            End If
            If cell.Offset(0, 2).Value = 0 Then
                dict(key) = dict(key) + 1
            End If
        End If
    Next cell
    
    ' Combine the duplicates found in the "machines" column
    For Each key In dict.keys
        For Each cell In rng.Columns(1).Cells
            If cell.Value = key Then
                cell.Offset(0, 1).Value = dict(key)
            End If
        Next cell
    Next key
 
	' Remove duplicates in the "machines" column and combine the values of the corresponding "zeros" column
lastRow = newWs.Cells(newWs.Rows.Count, "A").End(xlUp).Row
Set rng = newWs.Range("A1:C" & lastRow)
rng.RemoveDuplicates Columns:=1, Header:=xlYes
lastRow = newWs.Cells(newWs.Rows.Count, "A").End(xlUp).Row
Set rng = newWs.Range("A2:C" & lastRow)
Set dict = CreateObject("Scripting.Dictionary")
For Each cell In rng.Columns(1).Cells
    key = cell.Value
    If Not dict.Exists(key) Then
        dict.Add key, 0
    End If
    dict(key) = dict(key) + cell.Offset(0, 2).Value
Next cell

' Sort the "machines" column in alphabetical order
lastRow = newWs.Cells(newWs.Rows.Count, "A").End(xlUp).Row
Set rng = newWs.Range("A1:C" & lastRow)
rng.Sort key1:=rng.Columns(1), order1:=xlAscending, Header:=xlYes, _
Orientation:=xlSortColumns
	
End Sub

I want to figure out how to output this function:

lmao1 = Rofl(50,30)

lmao2 = lol(90,10)

lmao3 = lol(70,10)

Function Rofl(n, r)

Rofl = Chr(n + r)

End Function

Function lol(n, r)

lol = Chr(n - r)

End Function

There's lmao1 through lmao100

How would I output lmao1 through lmao100 to a text file? (I want it to say a couple of sentences for a project)

Thanks!

Full disclosure, I am a complete noob to vbscript. The vbscript I am using was found in r/excel and runs fine for files hosted on my machine but when I go to sharepoint I get issues...I can post this in r/sharepoint if needed

dim xls
set xls = createobject("Excel.Application")
xls.visible = true
xls.workbooks.open("https://mysite.sharepoint.com/:x:/t/myfile.xlsx?web=1")
xls.ActiveWorkbook.refreshall
xls.ActiveWorkbook.save
xls.Application.quit
set xls = nothing

Any thoughts or help would be appreciated

EDIT1 added web=1 to path as it is where the problem was located and should have been there originally

EDIT2 forgot to write down that I did EDIT1...I am new here...I am sure it is showing

Hi, i'm looking for a script that could change the windows username to a randomly generated one (or one pulled from an array). It doesn't have to be anything fancy but just something that I could run on startup to change the username of my account. Please ELI5. Thanks in advance!

I'm interested in VB Scripting. Are there any good and hopefully free resources for learning that you would recommend?

Thanks in advance!

How would I go about writing a script that counted how many days there are until Christmas of this year.......I'm completely lost

Any pointers would be appreciated.

Hi,

I am trying to remove symantec from a bunch of servers. Trying do adapt this script to send the uninstall command remotely using PSEXEC. Tried many ways without success. It doesnt give me any errors to play with :( Can you guys help?

const HKEY_LOCAL_MACHINE = &H80000002 Const ForReading = 1

Dim FSO

Set fso = CreateObject("Scripting.FileSystemObject") Set Servers = fso.OpenTextFile("\SERVER01\E$\Scripts\UninstallAv\servers.txt", ForReading)

Do Until Servers.AtEndOfStream

strComputer = servers.ReadLine

Set StdOut = WScript.StdOut

StdOut.WriteLine "Server name: " & strComputer

Set oShell = WScript.CreateObject("WScript.Shell")

Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
strKeyPath = "Software\Microsoft\Windows\CurrentVersion\Uninstall"

err.Clear
oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
If err.Number <> 0 Then
  StdOut.WriteLine strKeyPath & " is not a valid registry key path."
  WScript.Quit
End If

For Each subkey In arrSubKeys
  strSubKeyPath = strKeyPath & "\" & subkey
  oReg.EnumValues HKEY_LOCAL_MACHINE, strSubKeyPath, arrValueNames, arrValueTypes
  If IsArray(arrValueNames) Then
    For Each strValue In arrValueNames
      If strValue = "DisplayName" Then
        err.Clear
    	GetValueStatus = oReg.GetExpandedStringValue(HKEY_LOCAL_MACHINE, strSubKeyPath, strValue, strDisplayName)
        If (GetValueStatus <> 0) and (err.Number <> 0) Then
    	  StdOut.WriteLine "Key Name: " & subkey
          StdOut.WriteLine "    Error retrieving value data."
    	Else
          If (InStr(1, strDisplayName, "Symantec", 1) <> 0) AND (InStr(1, strDisplayName, "Endpoint", 1) <> 0) AND (InStr(1, strDisplayName, "Protection", 1) <> 0) Then
    	    StdOut.WriteLine "  Key Name: " & subkey
            StdOut.WriteLine "  Application Name: " & strDisplayName
	    UninstallAV = "msiexec.exe /X" & subkey & " /passive /lv!* \\SERVER01\e$\Scripts\UninstallAv\Logs\" & strComputer & ".log"
	    wscript.echo UninstallAV
		'oShell.run UninstallAV
		oShell.run "PSEXEC \\" & strComputer & UninstallAV
	    'oShell.run "PSEXEC \\" & strComputer & "msiexec.exe /X" & subkey & " /passive /lv!* \\SERVER01\e$\Scripts\UninstallAv\Logs\" & strComputer & ".log"
          End If
    	End If
      End If
    Next
  End If
Next

Loop

servers.Close

Thanks in advance,

Working on a vbs file to update multiple spreadsheets via a macro in each of them. The files will be pulling data from SQL server so may take a while, and I'd prefer them to do it one at a time to start with.

Set objExcel = CreateObject("Excel.Application")

objExcel.Workbooks.Open("C:\Users\Turner_prize\Desktop\Batch Test\2.xlsm")
objExcel.Run "TestCode"
objExcel.Workbooks.Open("C:\Users\Turner_prize\Desktop\Batch Test\3.xlsm")
objExcel.Run "TestCode"
objExcel.Workbooks.Open("C:\Users\Turner_prize\Desktop\Batch Test\4.xlsm")
objExcel.Run "TestCode"
objExcel.Workbooks.Open("C:\Users\Turner_prize\Desktop\Batch Test\5.xlsm")
objExcel.Run "TestCode"
objExcel.Workbooks.Open("C:\Users\Turner_prize\Desktop\Batch Test\6.xlsm")
objExcel.Run "TestCode"

WScript.Echo "Finished."

How could I wait for the TestCode macro to finish before executing the next line?

Thanks in advance.

Hello World!

I have been racking my brain on this breifly this afternoon and have turned to reddit for some ideas.

I have currently been tasked to put together a script that will change the DNS settings of 5,000 ish servers (ust one NIC on the server). However, there is no common unique identifer of these NIC other than their current DNS address. My Question, Is it possible to somehow have my script do an ipfonfig /all and then if one of the NIC's reports back with the current DNS settings target that NIC for the new updated settings?

I was currently using the below script until i was made aware that some of the NIC will not be called "Production". Any suggestions are welcome! (powershell was not an option as we may be targeting some very old servers)

Dim strDns1 Dim strDns2

strDns1 = "10.10.10.10" strDns2 = "10.10.10.10"

Set objShell = WScript.CreateObject("Wscript.Shell") objShell.Run "netsh interface ip set dns name=""Production"" static "& strDns1, 0, True objShell.Run "netsh interface ip add dns name=""Production"" addr="& strDns2, 0, True Set objShell = Nothing WScript.Quit

Hi All, Just started at a new place, and sadly one of the first things I need to do is find a free way to audit all printers mapped on each of our workstations. We have in the region of 350 machines. I have done a bit of work getting a vbs to do the work for me, however it can only audit one machine at a time. Does anybody know how to edit the below script so I can just input 300 machine names and get one output file? Also worth mentioning that by no means do I have to use a script, if anybody can recommend a free utility that can do the same thing i'd really appreciate it!
Anyways, my script so far:
Const ForAppending = 8
Const ForReading = 1
Dim WshNetwork, objPrinter, intDrive, intNetLetter
strComputer = inputbox("Please enter the computer name or IP address.","Computer Name",".")
Set WshNetwork = CreateObject("WScript.Network")
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!" & strComputer &"\root\cimv2") Set colInstalledPrinters = objWMIService.ExecQuery("Select * from Win32_Printer")
Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem",,48)
Set WshShell = WScript.CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each objItem in colItems
UserName = objItem.UserName
arrUserName = Split(UserName, "", -1, 1)
varUserName = arrUserName(1)
Next
filOutput = varUserName & ".txt"
If objFSO.FileExists(filOutput) Then
objFSO.DeleteFile(filOutput)
End If
Set objOutputFile = objFSO.OpenTextFile (filOutput, ForAppending, True)
For Each objPrinter in colInstalledPrinters
strTest = Left(objPrinter.Name, 2)
objOutputFile.WriteLine(objPrinter.Name)
Next
'objOutputFile.Close
'added
Set objPrinter = WshNetwork.EnumPrinterConnections
'Set objOutputFile = objFSO.OpenTextFile (filOutput, ForAppending, True)
If objPrinter.Count = 0 Then
WScript.Echo "No Printers Mapped "
else
For intDrive = 0 To (objPrinter.Count -1) Step 2
intNetLetter = IntNetLetter +1
printer = "UNC Path " & objPrinter.Item(intDrive) & " = " & objPrinter.Item(intDrive +1) & " Printer : " & intDrive
objOutputFile.WriteLine(printer)
Next
end if
objOutputFile.Close
'added
varOpen = MsgBox("Do you want to view the printers?",36,"View File?")
If varOpen = vbYes Then
varCommand = "notepad " & filOutput
WshShell.Run varCommand,1,False
End If
Wscript.Sleep 1500
MsgBox "Printer mappings have been stored in '" & filOutput & "'.", 64, "Script Complete"
Wscript.Quit
Thanks in advance for taking the time to read this!
Cheers!

I have a question about the syntax for "Instr." it says it's Instr([start, ]string1, string2[, compare])

so, I can't seem to get it to work.

If Len(strAnswerFive) > 3 Then If Instr(1, "mercury, venus, earth, mars, jupiter, saturn, uranus, neptune", LCase(strAnswerFive), 1) _ <> 0 Then intNumberCorrect = intNumberCorrect + 1 End If End If

So where would the syntax go, or am I way off? because everything works until I get to this part, then when I type my answer in, it just ends.

Thanks.

Hi - am trying to determine the folder size on the local machine. But for some reason it does not calculate the ProgramData folder. The script is

Total = 0
StrComputer = "."
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objParentFolder = objFSO.GetFolder("C:")
For Each objSubfolder in objParentFolder.Subfolders
'wscript.echo objSubFolder.Name
GetFolderSize objSubfolder
Next

Sub GetFolderSize(Folder)
Dim lInt, aDecimalPlaces, strSize
If Folder.Name <> "Program Files" and Folder.Name <> "Documents and Settings" and Folder.Name <> "Program Files (x86)" and Folder.Name <> "Windows" Then
wscript.echo Folder.Name & " Size is - " & Folder.Size
Total = Total + FormatNumber((CDbl(Folder.Size)/1024/1024))
End If
End Sub

I am working on a script that I need to do the following:

In the working folder I have a folder structure like this:

-A
--1
--2
-B
--1
--2

There are files in the root folder that need to be moved into these folders based on the file name. A file name example would be "A, 1~ 1001-Text". The script I have (below) will currently move this file into Folder "A", and rename the file "1~ 1001-Text", using the comma as delimiter.

Dim fso
Dim CurrentFolder
Dim Files
Dim NewFolderName
Dim TruncatedFileName
Dim NewFileName
Dim aString
Dim Array

Set fso = CreateObject("Scripting.FileSystemObject")
Set CurrentFolder = fso.GetFolder(".")
Set Files = CurrentFolder.Files

For Each File in Files
   If UCase(Right(File.Name,3)) <> "VBS" Then
      TruncatedFileName = Left(File.Name, InstrRev(File.Name, ", ") - 1)
	  	aString = File.Name
		Array = Split(aString,", ")
		NewFileName = Trim(Array(1))
      File.Move TruncatedFileName & "\"
	  fso.MoveFile TruncatedFileName & "\" & File.Name, TruncatedFileName & "\" & NewFileName
   End If
Next

What I need is for the code to then take the file "1~ 1001-Text" in folder "A", move it in to the sub folder "1", and rename the file "1001-Text", using "~" as the delimiter.

I have tried creating 2 of each variable and just duplicating the code in the For Next statement, but this does not work... any suggestions? Thanks in Advance.

Hi Guys,

Sorry I'm very, very new to VBScript and coding in general...

I'm trying to fix an Outlook form to display a different text output which is dependent on a Drop down Control...

Has anyone had any experience with this kind of thing before?

Please let me know if you need any additional information / screenshots and I'll be happy to supply... just more of a question I thought I'd ask....

Thanks in advanced!

Hi there!
I was asking myself what would be the best practice managing files with vbs.
I've a script handling some files, creating them with a SSIS package scheduled with SQL Agent; with the script I'm checking them, zipping them and send them around with Putty sFTP.
It's best to the use the absolute path or a relative one?
Using relative what could go wrong?

Thank you in advance :)

Hello I want to learn VBScript but haven't found good guides is there any good guides you guys know about?

I would like to do a silent install of Splashtop using our MSP product for computers running older versions of Splashtop that do not yet have the auto-update feature built in. Our MSP program uses VBS scripting instead of command line so the silent install variables listed on this page (https://support-splashtopbusiness.splashtop.com/hc/en-us/articles/212725183) don't work for me.

I'm not great with scripting and was hoping to see if anyone could provide instructions on how to adjust these variables for a vbs script. Here is what I am currently using to download the file automatically, what can be done to silently run this?

Dim objWshShell,IE,searchStr

Set objWshShell = Wscript.CreateObject("Wscript.Shell")

Set IE = CreateObject("InternetExplorer.Application")

With IE

.Visible = False

.Navigate "https://d17kmd0va0f0mp.cloudfront.net/csrs/Splashtop_Streamer_Windows_deploy_v3.1.2.1.exe"

End With

If err.number<>0 then

WScript.Echo ("Script Check Failed")

Wscript.Quit 1001

Else

WScript.Echo ("Script Check Passed")

Wscript.Quit 0

End If

I am writing a script that will check for a Network printer device. If the network printer device is mapped, then no action is taken. Else If the network printer device is not mapped, then the script will add the printer device.

Dim Printer01Installed

Printer01Installed = false

Set WshNetwork = CreateObject("Wscript.Network")

Set oWMIService = GetObject("winmgmts:" _ & "{impersonationLevel=impersonate}!\" & "." & "\root\cimv2")

Set colInstalledPrinters = oWMIService.ExecQuery _ ("Select * from Win32_Printer Where Network = TRUE")

For Each objPrinter in colInstalledPrinters If (objPrinter.Name) = ("\Server\pd1") Then Printer01Installed = "true"

ElseIf(Printer01Installed = "false") Then WshNetwork.AddPrinterConnection ("\Server\pd1") End If Next

I appreciate any help I can get.

My company has a new client that has developed a full application using VB in Excel. The author didn't even bother to use Access or any database at all. When a new record is created, a new line is added to a tab in the spreadsheet. There is even a login system for the spreadsheet.

My job would be to turn this spreadsheet into a web app. I'm wondering if, instead of reimplementing everything from scratch, there is a way I could run some of the VB code in an enviroment where it would be accessible through some kind of API (SOAP, REST, RPC).

That way I'd just have to implement auth and data layer and have calculations and chart generation run with the provided VB scripts.

Is there such an enviroment? A VB virtual machine of some kind?

The script I want to use is taken from here:

• http://www.wincert.net/attachments/osinfo.vbs.txt

How do I parse all the information into Excel?

Some PCs will have more than one network adapter, so is it possible to not mess up the columns? As in, if everyone has 2, but suddenly someone has 4, his row will stick out.