In my VBScript I am trying to run another VBScript to create a desktop shortcut if that desktop shortcut doesn't exist. If the desktop link does exist, it should not do anything. However, currently even if the desktop shortcut exists, the VBScript still runs. Why? No syntax error.
Dim objFSO, strDirectory, strFile
Set oShell = CreateObject ("WScript.Shell")
'getting script location
strPath = WScript.ScriptFullName
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.GetFile(strPath)
strFolder = objFSO.GetParentFolderName(objFile)
'define directory & file
strDirectory = oShell.ExpandEnvironmentStrings("%USERPROFILE%")
strFile = strDirectory & "\Desktop\My Program.lnk"
If objFSO.FileExists(strFile) Then
'DO NOTHING
Else
strDesk = "desktoplink.vbs"
oShell.Run strDesk, 0, False
End If
'enclosing path to support spaces
HMIpath = strFolder & "\CHK.bat"
HMIpath = """" & HMIpath & """"
Dim strArgs
strArgs = "cmd /c " & HMIpath
oShell.Run strArgs, 0, False
Related
I found this code for find and replace everywhere with VB6 in Word files, however it is early bound.
However I need it for late bound, since my EXE will be used on different systems, thus I can't use the Reference to Word Library.
What my code needs to do is:
Find Red text in all Word files and replace it with hidden font.
I had it working for the main text, but the header also contains red text and also needs to be hidden.
Here is my current code, which does not replace anything anymore.
Private Sub PREP_Click()
Const wdColorRed = 255
Dim oWordApp As Object
On Error Resume Next
Dim fs As Object
Dim rngStory As Object
Dim lngJunk As Long
Dim oFolder As Object
Dim tFolder As Object
Dim oFile As Object
Dim strDocName As String
Dim strPathName As String
Dim locFolder As String
locFolder = InputBox("Enter the folder path to the file(s) your want to prepare.", "File Preparation", "Type your path here... Make sure it end with a back slash, e.g. C:\myfiles\")
Set fs = CreateObject("Scripting.FileSystemObject")
Set oFolder = fs.GetFolder(locFolder)
Set tFolder = fs.CreateFolder(locFolder & "PREP")
Set tFolder = fs.GetFolder(locFolder & "PREP")
Set oWordApp = CreateObject("Word.Application")
Set rngStory = CreateObject("Word.Range")
For Each oFile In oFolder.Files
oWordApp.Visible = False
oWordApp.Documents.Open (oFile.Path)
lngJunk = oWordApp.ActiveDocument.Sections(1).Headers(1).range.StoryType
'Iterate through all story types in the current document
For Each rngStory In oWordApp.ActiveDocument.StoryRanges
'Iterate through all linked stories
Do
With oWordApp.rngStory.Find
oWordApp.rngStory.WholeStory
oWordApp.rngStory.Find.Font.Hidden = True
oWordApp.rngStory.Find.Replacement.Font.Hidden = False
oWordApp.rngStory.Find.Execute Replace:=2
End With
'Get next linked story (if any)
Set rngStory = rngStory.NextStoryRange
Loop Until rngStory Is Nothing
Next
strDocName = oWordApp.ActiveDocument.Name
oWordApp.ChangeFileOpenDirectory (tFolder)
oWordApp.ActiveDocument.SaveAs FileName:=strDocName
oWordApp.ChangeFileOpenDirectory (oFolder)
Next oFile
oWordApp.Quit
Set rngStory = Nothing
Set oWordApp = Nothing
End Sub
I think the problem is the rngStory part. Please help!
That code is not early bound Ben. It's late bound.
Dim oWordApp As Object
Set oWordApp = CreateObject("Word.Application")
Is late bound, every where your dealing with Object your dealing with a late binding.
I used Selection instead of Range and it is working now:
Private Sub PREP_Click()
Const wdColorRed = 255
Dim oWordApp As Object
On Error Resume Next
Dim fs As Object
Dim rngStory As Object
Dim myDoc As Object
Dim oFolder As Object
Dim tFolder As Object
Dim oFile As Object
Dim strDocName As String
Dim strPathName As String
Dim locFolder As String
locFolder = InputBox("Enter the folder path to the file(s) your want to prepare.", "File Preparation", "Type your path here... Make sure it end with a back slash, e.g. C:\myfiles\")
Set fs = CreateObject("Scripting.FileSystemObject")
Set oFolder = fs.GetFolder(locFolder)
Set tFolder = fs.CreateFolder(locFolder & "PREP")
Set tFolder = fs.GetFolder(locFolder & "PREP")
Set oWordApp = CreateObject("Word.Application")
For Each oFile In oFolder.Files
oWordApp.Visible = False
oWordApp.Documents.Open (oFile.Path)
oWordApp.ActiveDocument.Sections(1).Headers(1).Range.Select
oWordApp.Selection.WholeStory
oWordApp.Selection.Find.Font.Color = wdColorRed
oWordApp.Selection.Find.Replacement.Font.Hidden = True
oWordApp.Selection.Find.Execute Replace:=2
oWordApp.ActiveDocument.Select
oWordApp.Selection.WholeStory
oWordApp.Selection.Find.Font.Color = wdColorRed
oWordApp.Selection.Find.Replacement.Font.Hidden = True
oWordApp.Selection.Find.Execute Replace:=2
strDocName = oWordApp.ActiveDocument.Name
oWordApp.ChangeFileOpenDirectory (tFolder)
oWordApp.ActiveDocument.SaveAs FileName:=strDocName
oWordApp.ChangeFileOpenDirectory (oFolder)
Next oFile
oWordApp.Quit
Set oWordApp = Nothing
End Sub
I am trying to create a script that will ask the user if they want to set a network printer as their default. My problem is that no matter what they select (yes or no) it set it up as the default and it always echo's my the echo statement under else. Can someone tell me what I am doing wrong?
` ' Printers.vbs - Windows Logon Script.
printername = "DCPTTEAM462W"
server = "DCDEPLOY03"
Dim objectNetwork, printer
printer = "\\DCPRINT03\DCPTTEAM462W"
Msgbox printername & " will now install on your computer.",0, "Add printer" & printername
intRespnseY = Msgbox("Would you like " & printername & " to be set as your default printer", vbYesNo, "Set as Default")
If intResponseY = vbNo Then
Set objNetwork = CreateObject("WScript.Network")
objNetwork.AddWindowsPrinterConnection printer
WScript.Echo "DCPTTEAM462W was added as a printer."
Else
Set objNetwork = CreateObject("WScript.Network")
objNetwork.AddWindowsPrinterConnection printer
objNetwork.SetDefaultPrinter printer
WScript.Echo "DCPTTEAM462W has been set as your default printer."
End If
`
You have a typo:
intRespnseY = Msgbox(....
Should be
intResponseY = Msgbox(....
Use
Option Explicit
to avoid blunders like:
intRespnseY = Msgbox("...")
If intResponseY = vbNo Then
(mark the missing "o")
I want to check the path given by user is a directory or a file in vbscript. Is there any regular expression or the other ways I can do this ? Any help would be great.
Function GetFSElementType( ByVal path )
With CreateObject("Scripting.FileSystemObject")
path = .GetAbsolutePathName( path )
Select Case True
Case .FileExists(path) : GetFSElementType = 1
Case .FolderExists(path) : GetFSElementType = 2
Case Else : GetFSElementType = 0
End Select
End With
End Function
Function IsFile( path )
IsFile = ( GetFSElementType(path) = 1 )
End Function
Function IsFolder( path )
IsFolder = (GetFSElementType(path) = 2 )
End Function
Function FSExists( path )
FSExists = (GetFSElementType(path) <> 0)
End Function
WScript.Echo CStr( IsFile("c:\") )
WScript.Echo CStr( IsFolder("c:\") )
WScript.Echo CStr( FSExists("c:\") )
Add this function to your code and use it, feel free to change sAns to some public Const.
Function IsFileOrFolder(sInputText)
Dim sAns, oFSO
sAns = "No such a File or Folder!"
Set oFSO = CreateObject("Scripting.FileSystemObject")
If oFSO.FileExists(sInputText) Then sAns = "FILE: " & sInputText
If oFSO.FolderExists(sInputText) Then sAns = "FOLDER: " & sInputText
Set oFSO = Nothing
IsFileOrFolder = sAns
End Function
I am trying to write a script that will copy files from folder A to folder B, it will copy only files that come from a list file.
I then need it to log any files that failed to copy. Here is what I have so far, I just cannot get logging to work.
Option Explicit
Dim Sour, Dest
Dim oFSO, sFile, oFile, sText
Dim objFSO, objFileCopy
Dim strFilePath, strDestination, strSource
Const ForReading = 1, ForWriting = 2, ForAppending = 8
strLoggingFiles = "C:\failedtransfer.txt"
strSource = InputBox("Enter source path information") 'Enter your source path here
strDestination = InputBox("Enter destination path information") 'Enter your destination path here
'Set the read of the input file and prompt for location
Set oFSO = CreateObject("Scripting.FileSystemObject")
sFile = InputBox("Enter path to text document with files to be copied:")
'Open the read, get the file name of the file to be copied, and copy it to new location
If oFSO.FileExists(sFile) Then
Set oFile = oFSO.OpenTextFile(sFile, ForReading)
Do While Not oFile.AtEndOfStream
sText = oFile.ReadLine
If (Trim(sText) <> "") And _
oFSO.FileExists(strSource & "\" & sText) Then
oFSO.CopyFile strSource & "\" & sText, strDestination
Else
WScript.Echo "Couldn't find " & strSource & "\" & sText
End If
Loop
oFile.Close
Else
WScript.Echo "The file was not there."
End If
Here's the code. It'll log the source file names (full path) if they are missing or failed when being copied. Please note that in Vista/Win7+, you'll need Administrator rights if you want to put a file in the root directory.
Option Explicit
Dim Sour, Dest
Dim oFSO, oLog, sFile, oFile, sText
Dim objFSO, objFileCopy
Dim strFilePath, strDestination, strSource
Const ForReading = 1, ForWriting = 2, ForAppending = 8
strLoggingFiles = "C:\failedtransfer.txt"
strSource = InputBox("Enter source path information") 'Enter your source path here
strDestination = InputBox("Enter destination path information") 'Enter your destination path here
'Set the read of the input file and prompt for location
Set oFSO = CreateObject("Scripting.FileSystemObject")
sFile = InputBox("Enter path to text document with files to be copied:")
'Open the read, get the file name of the file to be copied, and copy it to new location
If oFSO.FileExists(sFile) Then
'Open/create log file
set oLog = oFSO.OpenTextFile(strLoggingFiles, ForAppending, True)
Set oFile = oFSO.OpenTextFile(sFile, ForReading)
Do While Not oFile.AtEndOfStream
sText = oFile.ReadLine
If (Trim(sText) <> "") And _
oFSO.FileExists(strSource & "\" & sText) Then
On Error Resume Next 'disable quit on error
oFSO.CopyFile strSource & "\" & sText, strDestination
If Err.Number <> 0 Then
oLog.WriteLine strSource & "\" & sText 'log failed copy
End If
On Error Goto 0 'enable quit on error
Else
WScript.Echo "Couldn't find " & strSource & "\" & sText
oLog.WriteLine strSource & "\" & sText 'log failed copy 'log missing source
End If
Loop
oFile.Close
oLog.Close 'close log file
Else
WScript.Echo "The file was not there."
End If
At some point I got tired of writing logging routines over and over again, so I wrote a class (CLogger) as an abstraction layer for logging to different facilities (console, eventlog, file):
Set clog = New CLogger
clog.LogFile = "C:\failedtransfer.txt"
clog.LogToConsole = False
clog.LogToEventlog = False
'...
On Error Resume Next
oFSO.CopyFile strSource & "\" & sText, strDestination
If Err Then
clog.LogError strSource & "\" & sText & ": " & FormatErrorMessage(Err)
End If
On Error Goto 0
'...
Hi I am using WMI to change the remote registry value for USBSTOR. I want to change the value of start attribute to 4 or 3 for enabling and disabling.
But the datatype for Start attribute in registry is DWORD, if i can the datatype to size it does not work .
I need to keep the Datatype to DWORD. Can someone please tell me how to setDWORDValue using WMI, following is the piece of code that i tried, it worked succesfully but still the value of start field is unchanged in registry.
const uint HKEY_LOCAL_MACHINE = 0x80000002;
ManagementBaseObject methodParams = registryTask.GetMethodParameters(typeOfValue);
methodParams["hDefKey"] = HKEY_LOCAL_MACHINE;// BaseKey;
methodParams["sSubKeyName"] = #"SYSTEM\\CurrentControlSet\\Servic\\USBSTOR";
methodParams["sValueName"] = "Start";
try
{
methodParams["sValue"] = "3";
}
catch
{
methodParams["uValue"] = (UInt32)Convert.ToInt32("3");
}
ManagementBaseObject exitValue = registryTask.InvokeMethod(typeOfValue, methodParams, null);
Simple solution using python.
import wmi
import win32api,_winreg
c = wmi.WMI()
# To get the binary value of particular subkey
# Please note that 0x80000002 represents HKEY_LOCAL_MACHINE
ReturnValue, uValue = c.StdRegProv.GetBinaryValue(0x80000002,"AFD","SYSTEM\CurrentControlSet\Services")
# To get the list of all the subkeys available in particular key
ret, subKeys = c.StdRegProv.EnumKey (0x80000002, "SYSTEM\CurrentControlSet\Services")
print ret
for key in subKeys:
print key
ReturnValue=c.StdRegProv.SetDWORDValue(0x80000002,"Type","SYSTEM\CurrentControlSet\Services\USBSTOR",0x4)
#HKEY_CLASSES_ROOT (2147483648 (0x80000000))
#HKEY_CURRENT_USER (2147483649 (0x80000001))
#HKEY_LOCAL_MACHINE (2147483650 (0x80000002))
#HKEY_USERS (2147483651 (0x80000003))
#HKEY_CURRENT_CONFIG (2147483653 (0x80000005))
#HKEY_DYN_DATA (2147483654 (0x80000006))
Yes it can be done. Here's the code, referencing this Microsoft link and this one. Replace 3389 with the new value you want to use, and change the key as needed:
const HKEY_LOCAL_MACHINE = &H80000002
strComputer = "."
'Set StdOut = WScript.StdOut
Set oReg=GetObject( _
"winmgmts:{impersonationLevel=impersonate}!\\" &_
strComputer & "\root\default:StdRegProv")
strKeyPath = "SYSTEM\CurrentControlSet\Control\Terminal Server\WinStations\RDP-Tcp"
strValueName = "PortNumber"
' Display old value
oReg.GetDWORDValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,dwValue
WScript.Echo "Old RDP value=" & dwValue
' Set new value
dwValue= 3389
oReg.SetDWORDValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,dwValue
If Err = 0 Then
oReg.GetDWORDValue _
HKEY_LOCAL_MACHINE,strKeyPath,strValueName,dwValue
WScript.Echo "New RDP Value =" & dwValue
Else
WScript.Echo "Error in creating key" & _
" and DWORD value = " & Err.Number
End If