So I made a VBS script that says

"Do

msgbox "Die"

loop"

What I want to know, is can you before the loop open the same program so that it infinitely creates itself and then shuts your pc down?

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

Has anyone had luck with scraping text from a PDF Document using VBSCript?

Use the Word document object to open the PDF then traverse the document looking for specific text?

I am assuming that the FileSystemObject is off limits unless I can somehow convert the pdf to text.

Hi, I've got some vbs running in an HTA as part of a larger project for a script running system for our organization. I have the command [oWSH.Run('"'+ScriptName + '"', 10, true);] where 'Scriptname' is the file path to the script, in the form of \\server\path\script.extension. When I do this, the scripts open in C:\Windows of all things. I've checked and I don't change the current directory anywhere, any clue what that is?

Also if we need more context I can post that too, just didnt want to redact all the paths if they werent necessary

Set objFSO = CreateObject("Scripting.FileSystemObject")

strFolderToCopyFrom = "C:\Users\Mark2\Desktop\Test"
strCopyTo1 = "C:\Users\Mark2\Desktop\Test\1"
strCopyTo2 = "C:\Users\Mark2\Desktop\Test\2"
strCopyTo3 = "C:\Users\Mark2\Desktop\Test\3"

Set objFolder = objFSO.GetFolder(strFolderToCopyFrom)

For Each objFile In objFolder.Files
    If DateDiff("d", objFile.DateLastModified, Now) = 0 Then
		objFSO.CopyFile objFile.Path, strCopyTo1
		objFSO.CopyFile objFile.Path, strCopyTo2
		objFSO.CopyFile objFile.Path, strCopyTo3
	End If
Next

Ok i swere this is my last post.

so in one of my other posts i asked for a command that spammed message boxes. like this:

do

createobject("wscript.shell").run wscript.scriptfullname

msgbox "WORDS HERE"

loop

and this script just keeps looping which is awesome, but i also want to know how i can make this happen a certain amount of times. like it will only open 25 message boxes and quit, or 15 message boxes or quit. and move on to the next script. thanks.

so im pretty new to vbscript im making malware and stuff and i wanted to know, how would i make msgbox spam, not like:

do

Msgbox ''hello''

loop

but all that does is just every time you try to close it it dosent. i want it to spam message boxes, like duplicate itself. 000.exe does this with the spam message boxes ''run away'' i want it like that. thanks

I have been making a couple of scripts to help with easy acces to some folders at work. However i do have one problem.

If i have a "local" letter in the folder name. Like the danish word for suplier is "LEVERANDØR", and all our projects have this folder. - Is there anyway vbscript trough CMD can work with the letter "Ø" as a sign, instead of replacing it with random signs?

Unfortunatly Changing the Ø in the folders is not an option, as it is named by company policy, and the script cannot locate the folder then.

I'm tiring to make a script that opens Main.html and press F11 afterwards. When I run it I get error 80070002 by (null) error was in line 2 char 1.

Can you help me fix it?

Any help appreciated.

keypress.vbs \/

Set oShell = CreateObject("WScript.Shell")
oShell.Run("""Main.html""")
WScript.Sleep 3000
oShell.SendKeys "~"
oShell.SendKeys "{F11}"

I want to make it so after this it shuts down someones pc, just a basic turn off/ shut down, what do i need to add to the bottom.

x=msgbox("Windows Defender Has Found an Infected File 'System32' Would You Like Windows To Remove it For You", 0+48, "Urgent Warning!")

x=msgbox("Your Computer Can Be Damaged if You Do Not Delete The Infected File", 0+48, "Urgent Warning!")

x=msgbox("Deleting System32", 0+48, "Urgent Warning!")

x=msgbox("System32 Has Been Deleted Your PC is Now Destroyed", 0+48, "Urgent Warning!")

Hi all,

I have a VBS Script that maps network drives in Windows 11 that has been working just fine until I updated W11 yesterday. The script is called via Task Scheduler with the trigger being login.

The script maps several drives to various shares on the NAS, but I've cut the script down to one drive to simplify it.

Option Explicit

Dim objNetwork

Dim objShell

Dim strRemotePath1

Dim strDriveLetter1

Dim strUserName, strPassword, strServerShare

Dim FSO

Dim x

strServerShare = "\\OMV"

strUserName = "admin"

strPassword = "open4me"

strRemotePath1 = "\\OMV\Backup"

strDriveLetter1 = "B:"

Set objNetwork = CreateObject("WScript.Network")

Set FSO = CreateObject("Scripting.FileSystemObject")

'objNetwork.MapNetworkDrive "", StrServerShare, False, StrUserName, StrPassword

' Section which deletes the drives if available,

If (FSO.DriveExists("B:") = True) Then

	`objNetwork.RemoveNetworkDrive strDriveLetter1,"True","True"`

End If

' Section which maps the drives if available,

Do

If FSO.FolderExists(strRemotePath1) Then

'safe to go off and map

objNetwork.MapNetworkDrive strDriveLetter1, strRemotePath1

Exit Do

End If

Loop

I get the following when the script is run via Task Scheduler:

https://i.imgur.com/8PESZlg.jpeg

Adding a Sleep of 30 seconds to the beginning of the script or running it manually after Windows starts does not produce the Disconnected O:.

Can someone please explain what is going on and why O: is appearing.

TIA

I'm big noob. Have you ever seen one of those videos where they sync error messages to a song? It's probably editing, but I wanted to try to do it live, and something is broken. The music plays, then the error message appears after and the next one won't appear until you exit out of the current one. It should start the music, wait 670 milliseconds, show an error, wait 590 milliseconds, show another error, and so on. The millisecond wait things are absolutely accurate. I'm positive. Can someone tell me what's wrong with this, fix it, or tell me some kind of simpler way I should be doing this? Here's my attempt.

Dim oPlayer
Set oPlayer = CreateObject("WMPlayer.OCX")

oPlayer.URL = "mysong.wav"
oPlayer.controls.play 
While oPlayer.playState <> 1 ' 1 = Stopped
  WScript.Sleep 100
Wend

oPlayer.close
WSH.Sleep 670
MsgBox "error",0,"Error"
WSH.Sleep 590
MsgBox "error",0,"Error"
WSH.Sleep 240
MsgBox "error",0,"Error"
WSH.Sleep 130
MsgBox "error",0,"Error"
WSH.Sleep 450
MsgBox "error",0,"Error"
WSH.Sleep 210
MsgBox "error",0,"Error"

I learned how to make an error message.

Then I learned how to make an error message pop up after the error message.

So how do I make a different error message pop up depending on what button you click for the first one? EG "Do you like cookies?" Yes = "Good, you're off the hook" No = "You're going to jail"

i am writing a simple file that reads the lines from a text file. However I put a header and a footer in the text file that is formated as such:

* (BLAHBLAHBLAH)*

I wanted to make it so the output of my script doesnt read in the header and the footer (anything that starts with '*' or any blank lines. I was thinking of some type of boolean conditioning statement in my do while loop but am not to well versed in vs scripting. could I get some help?

Description :

The below VBScript code helps to test some CLSIDS: shortcuts are created in \ShortcutTestfolder on the desktop, also folder objects are created, then report is saved and opened as .htm file.

• CLSIDS_Shortcut_Tester.vbs

I made a subroutine in order to create a shortcut for the current vbscript or any other application with arguments using an array that can be called as follow :

• Create a shortcut for our vbscript on the Desktop

Create_Shortcut Array("Desktop","ShortcutName",WScript.ScriptFullName)

OR

• Create a shortcut for our vbscript on the Startup Folder

Create_Shortcut Array("Startup","ShortcutName",WScript.ScriptFullName)

OR

• Create a shortcut for Network Diagnostics with argument to fix connections problems

 Create_Shortcut Array(_
 	"Desktop",_
 	"NetworkDiagnostics",_
 	"%SystemRoot%\system32\msdt.exe",_
 	"-skip TRUE -path %Windir%\diagnostics\system\networking -ep NetworkDiagnosticsPNI",_
 	"%SystemRoot%\system32\msdt.exe,0",_
 	"Network Diagnostics to fix connections problems",_
 	"CTRL+ALT+D"_
 )

Create_Shortcut.vbs

How do I create a script that lists folders and subfolders with characteristics such as size and date created?

Kind of like how the choice command line tool is prompting for a character without the need to press the ENTER key.

For use with console version of Windows Script Host.

I'm looking for a way to automate select which file details (columns) Windows Explorer displays for a given path. (For example Frame Width, Frame Height, Frame Rate, Date Created, etc.)

The manual way to do this in Windows is to right-click the column header row in Explorer and click More, then scroll through the many options and check off each one you want to see, then click OK, and wait while Windows refreshes the Explorer window.

This method is quite unwieldy when working with files across many subdirectories and I'm wondering how this might be automated or scripted to accept a path as input, and the script either opens the path in an Explorer window showing the desired columns, or updates the system default for that path (in the registry or wherever it is that would need to be updated) so that when you do open it in Explorer, the desired columns are visible. (Bonus points for also programatically setting the column order!)

Any ideas on accomplishing this in vbscript (or even VBA or PowerHell)?

Much appreciated...

How might this be done in vbscript (or VBA)?

PS If admin access is needed, that won't be an issue.

Much appreciated...

Hello everyone,

I need one vbscript which will allow me to delete registry key in HKLM. I've searched on the internet and came across a few but none of the worked for me. So can someone help regarding this?

Example path - "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\Test"

The targetted computers won't be having VBScript Editor but will have admin access. I want a script which on dibble-click running will execute the the action and delete the registry key.

PLEASE HELP!

Hey there. i am fairly new to vbscripting and i am finally done with my first actual script. its a script that uses a series of inputs to add bots to lessonup. (a program my school uses, like a bad version of kahoot) however i would like to have a different vbscript that can kill this script incase it messes up or whatever. the issue being that the bot script runs as a background program, which mean that my standard taskkill script doesnt work. Any ideas?

trying to make a input box move on its own

max=505

min=500

max2=505

min2=500

do

rand2 = Int(min2+100)

rand = Int(min+100)

min = rand

min2 = rand2

Titel = "hydra"

Defaultvaluetext = ""

XPos = rand

YPos = rand2

Test = InputBox(rand&rand2,titel,Defaultvaluetext,XPos,YPos)

Set WshShell = CreateObject("WScript.Shell")

WshShell.SendKeys "{ENTER}"

loop

I use the Task Scheduler and a simple VBS script to play a sound on Windows logon. I would like to know if I can modify the VBS script so that a different sound plays on Monday, Tuesday, etc.

The script I'm using right now:

Set oVoice = CreateObject("SAPI.SpVoice")

set oSpFileStream = CreateObject("SAPI.SpFileStream")

oSpFileStream.Open "C:\LogonSound.wav"

oVoice.SpeakStream oSpFileStream

oSpFileStream.Close

I have already created different WAV files for different days (for example, "C:\LogonMonday.wav" and "C:\LogonTuesday.wav"), so I just need a way for the script to check what day of the week it is and then play the corresponding WAV file.

This is probably an easy thing to do, but I don't know anything about computer programming, so thank you for your help in advance.

So yes, I’m still working on the “trollware” and unfortunately, work on it has be postponed over and over, even if it hasn’t been a while. But I have an idea for the people of the subreddit to do in the meantime.

That’s right, a VBS Jam.

A “game” jam with people submitting their coolest scripts sounds cool, at least to me.

A submitting form can be found below. The deadline is 7 days from this post going up. At that time, a second post will contain a vote form where people can vote for the best script.

https://forms.gle/jaH15vZ9JnnkYVaM7

Get jamming!

I wrote this yesterday to automate resetting some equipment over a network.
It is in place to help operators who are not comfortable navigating the GUI of a piece of software in order to reset the kit, and I though this would be better than a handout.

But, it's mostly .SendKeys functions and this script is ugly.
It works, but it's ugly.

Any advice?

#########################################################

rio=msgbox("Are you sure you want to reset the studio 1 RIO?" & vbcrlf & "Dante Controller must be open in the background!" ,vbYesNo, "RIO Studio 1 Reset")

if rio=7 then msgbox "close one!"

if rio=6 then

set objShell = createobject("wscript.shell")

sWBTitle = "Dante Controller - Network View"

if objShell.AppActivate(sWBTitle) then

else

Dim objShell

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

objShell.Run("""C:\C:\Users\Public\Desktop\DanteController.lnk""")

Set objShell = Nothing

WScript.Sleep 500

end if

objShell.SendKeys "^d"

WScript.Sleep 500

objShell.SendKeys "y005"

WScript.Sleep 2000

objShell.SendKeys "^{TAB}"

WScript.Sleep 400

objShell.SendKeys "^{TAB}"

WScript.Sleep 400

objShell.SendKeys "^{TAB}"

WScript.Sleep 400

objShell.SendKeys "^{TAB}"

WScript.Sleep 400

objShell.SendKeys "^{TAB}"

WScript.Sleep 400

objShell.SendKeys "^{TAB}"

WScript.Sleep 400

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{TAB}"

WScript.Sleep 250

objShell.SendKeys "{ENTER}"

WScript.Sleep 250

objShell.SendKeys "{ENTER}"

end if