If folder exist create shortcut this folder in MyDocuments VBS - vbscript

I want to create a shortcut in my documents only if will be existed a network share.
I'm trying to solve for a long time, but i still have problem with this.
Any help or suggestions would be greatly appreciated.
Dim strSkanSou
Dim objMyDocuments
strSkanSou = "\\Network\Scan\%username%"
IF strSkanSou.FolderExists then
Set objShell = CreateObject("WScript.Shell")
objMyDocuments = objShell.SpecialFolders("MyDocuments")
Set objLink = objShell.CreateShortcut(objMyDocuments & "\Skaner.lnk")
objLink.Description = "Skaner"
objLink.TargetPath = strSkanSou
objLink.Save
End If

You've got most of it solved already. You just need to create a FileSystemObject to check for the existence of your folder. Replace:
IF strSkanSou.FolderExists then
With:
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists(strSkanSou) Then
Also, I see you're using the prefixes str for string and obj for object, which is great, but you may want to use strMyDocuments instead of objMyDocuments, since this is actually a string and not an object.

Related

VBS to run Multiple Macros

I am using this VBS to run a macro on an excel document that has several macros in it. Is there a way to run more than one macro on a single VBS or will I have to create several?
This is the code I am using.
strPath = "C:\Users\michael\Desktop\sced.xlsm"
strMacro = "Macro3"
Set objApp = CreateObject("Excel.Application")
objApp.Visible = True
Set wbToRun = objApp.Workbooks.Open(strPath)
objApp.Run strMacro
wbToRun.Save
wbToRun.Close
objApp.Quit
I was thinking that I would just be able to list the macros;
strMacro = "Macro3"
strMacro = "Macro4"
but it only runs the last macro on the list.
Thanks in advance.
Simplest solution for your needs is this:
strMacro1 = "Macro3"
strMacro2 = "Macro4"
strPath = "C:\Users\michael\Desktop\sced.xlsm"
Set objApp = CreateObject("Excel.Application")
objApp.Visible = True
Set wbToRun = objApp.Workbooks.Open(strPath)
objApp.Run strMacro1
objApp.Run strMacro2
wbToRun.Save
wbToRun.Close
objApp.Quit

Use VBScript to show properties dialog/sheet - for multiple items

I'm trying to write a script in VBS to show the file properties dialog/sheet for multiple items. Those items will be all of the items in a parent folder (e.g. all items in W:\).
Essentially, I'm trying to get the properties dialog to show the number of files in a drive. Right-clicking on the drive and selecting Properties does not show the number of files. You would instead need to go into the first level of the drive, select all folders/files, and then right-click and select Properties.
I have customised some code (below) I've found on the internet to bring up the file properties dialog/sheet for either a specific folder, or a drive. I have no idea what I could further change to get the properties dialog for all files and folder of a specified drive. Perhaps getting all folders/files of the drive into an array and then working with that?
Please note I'm looking for the actual properties dialog, and not just a simple return of the total number of files (I know how to do this).
Any help would be appreciated! Thanks :)
Code:
dim objShell, objFSO, folParent, sParent, filTarget, sFileName, sOutput, fivVerbs, iVerb, vVerb, fvbVerb, testItemsParent, TestMappedDestination
set objFSO = CreateObject("Scripting.FileSystemObject")
set objShell = CreateObject("Shell.Application")
const mappedDestination = "c:\"
vVerb = "P&roperties"
sParent = objFSO.GetParentFolderName(mappedDestination)
sFileName = objFSO.GetFileName(mappedDestination)
If Len(mappedDestination) = 3 then
nsTarget = &H11
TestMappedDestination = "(" & UCase(Left(mappedDestination,2)) & ")"
Else
nsTarget = sParent
TestMappedDestination = UCase(sFileName)
End If
set folParent = objShell.Namespace(nsTarget)
For each filTarget in folParent.Items
If Len(mappedDestination) = 3 then
testItemsParent = UCase(Right(filTarget,4))
Else
testItemsParent = UCase(filTarget)
End if
If testItemsParent = TestMappedDestination then
Set fivVerbs = filTarget.Verbs
For iVerb = 0 to fivVerbs.Count - 1
If fivVerbs.Item(iVerb).Name = vVerb then
Set fvbVerb = fivVerbs.Item(iVerb)
fvbVerb.DoIt()
filTarget.InvokeVerbEx fvbVerb.Name, ""
Msgbox "Placeholder msgbox to keep properties dialog/sheet from disappearing on script completion"
Exit for
End if
Next
Exit for
End if
Next

VBScript to copy file/s beginning with XXX or YYY or ZZZ from directory A to directory B

I have next to zero knowledge on vbs scripting but I have managed to cobble a few together to copy files from one directory to another and delete files in a directory but I've not been able to find anything specifically what I'm now after.
I'm looking to write a vbs script to do the following - copy file/s beginning with XXX or YYY or ZZZ from directory A to directory B.
I've had a look around and cannot quite find what I'm looking for, they all seem far too complex for what I need and involve the latest date or parsing a string within the files etc.
I'm quite sure this is simple but as stated at the top I really do not know what I'm doing so any help would be greatly appreciated.
The following is what I have for copying all files from one directory to another with a progress bar so a amendment to this would be great.
Const FOF_CREATEPROGRESSDLG = &H0&
' copy test 1 to test 2
strTargetFolder = "C:\test2\"
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.NameSpace(strTargetFolder)
objFolder.CopyHere "C:\test1\*.*", FOF_CREATEPROGRESSDLG
Not sure as of yet how to get this in one big progress indicator. Currently it will show progress for each individual file.
Const FOF_CREATEPROGRESSDLG = &H0&
strSourceFolder = "C:\test1\"
strTargetFolder = "C:\test2\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objSourceFolder = objFSO.GetFolder(strSourceFolder)
Set objFiles = objSourceFolder.Files
Set objShell = CreateObject("Shell.Application")
Set objTargetFolder = objShell.NameSpace(strTargetFolder)
For Each objSingleFile in objFiles
If (InStr(1,objSingleFile.Name,"xxx",vbTextCompare) = 1) Or _
(InStr(1,objSingleFile.Name,"yyy",vbTextCompare) = 1) Or _
(InStr(1,objSingleFile.Name,"zzz",vbTextCompare) = 1) Then
' The file name starts with one the flagged keywords
objTargetFolder.CopyHere objSingleFile.Path, FOF_CREATEPROGRESSDLG
End If
Next
Keep your strTargetFolder code which is used for the actual copy procedure used at the end of the script. Using the FileSystemObject objFSO we cycle through all the files of the directory c:\test1. Each file name is then checked to see if it starts with either of 3 different strings. The comparison is done using vbTextCompare which essentially has it running case insensitive. If a match is found then, using your original code, copy the file to the target directory with progress.
Currently this is not going to recursively navigate all subfolders for file but you could make a recursive function for that.
Use the FileSystemObject in combination with a regular expression:
src = "C:\test1"
dst = "C:\test2"
Set fso = CreateObject("Scripting.FileSystemObject")
Set re = New RegExp
re.Pattern = "^(XXX|YYY|ZZZ)"
For Each f In fso.GetFolder(src).Files
If re.Test(f.Name) Then f.Copy dst & "\"
Next

vbscript bad file name when using variable from text file

I want to create a vbscript program that reads a .ini file to get parameters and use it.
My parameter file contains several parameters:
propertyfile.ini
"C:\PROGRA~1\narrowcast\scripts\transferStatusLog.txt"
..other parameters
..more parameters
my vbscript will read the file and use it
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objPropertyFile = objFSO.OpenTextFile("C:\PROGRA~1\scripts\propertyfile.ini", 1)
Do Until objPropertyFile.AtEndOfStream
myfile = objPropertyFile.ReadLine
... other parameters for use on other fso object
Loop
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objLogProgram = objFSO.CreateTextFile(myfile)
Im having an error bad file name or number. Please help
You are reading in the quotes - vbscript is not liking that. You'll need to strip them off.
Here's a quick and dirty replacement. Don't forget to add a check to see if it exists - otherwise if it doesn't you'll probably get a path not found error.
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objPropertyFile = objFSO.OpenTextFile("C:\PROGRA~1\scripts\propertyfile.ini", 1)
Do Until objPropertyFile.AtEndOfStream
myfile = replace (objPropertyFile.ReadLine,"""","")
Loop
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objLogProgram = objFSO.CreateTextFile(myfile)
What are we doing here?
We are simply telling vbscript to replace the double quote character with nothing (we had to "escape it, by double quoting, etc):
myfile = replace (objPropertyFile.ReadLine,"""","")
I hope this helps.

Replacing SubString values with the Replace function

The code below looks in the test folder for any files that have not been accessed in over 5 days, if it finds one it assigns mRoot the file path and then whats NOT WORKING is using the Replace method to look inside the mRoot string for the IP and replace it with the new one, I have it show me what mRoot looks like in a pop up just to make sure it changes(or doesn't). I can't seem to get the IP to change. Can anyone help out? I'm very new to VBS so I'm hoping this is obvious (whether it is doable or not). Thanks.
Set oFileSys = WScript.CreateObject("Scripting.FileSystemObject")
sRoot = "\\192.168.1.104\test\"
today = Date
Set aFolder = oFileSys.GetFolder(sRoot)
Set aFiles = aFolder.Files
For Each file in aFiles
FileAccessed = FormatDateTime(file.DateLastAccessed, "2")
If DateDiff("d", FileAccessed, today) > 5 Then
Set objShell = Wscript.CreateObject("Wscript.Shell")
mRoot = file
Call Replace(mRoot,"\\192.168.1.104","\\192.168.1.105")
objShell.Popup mRoot,, "My Popup Dialogue box"
'oFileSys.MoveFile file, mRoot
End If
Next
Try mRoot = Replace(mRoot,"\\192.168.1.104","\\192.168.1.105")

Resources