When we moved Documents and Settings folder completely from C to D drive , the product addon installation is not working , this ends up with popup windowsFolderSplit(0):C and error Folder doesn't exisit? For a systems having single partition this is working fine but only for multiple partitions this is not working
Here is the bit of vbscript code used in the installation script, Do i need to do any modification here ??
Dim windowsFolder ' For finding shortcut location
Dim windowsFolderSplit ' For isolating the WINDOWS drive
windowsFolder = fso.GetSpecialFolder(WindowsFolder)
If DEBUG = "D1" Then
MsgBox "windowsFolder:" & windowsFolder
End If
windowsFolderSplit = Split(windowsFolder, "\", -1, 1)
If DEBUG = "D1" Then
MsgBox "windowsFolderSplit(0):" & windowsFolderSplit(0)
MsgBox "windowsFolderSplit(1):" & windowsFolderSplit(1)
End If
Set docAndSetFolder = fso.GetFolder(windowsFolderSplit(0) & "\Documents and Settings")
Does it hardcoding values in to 'C' drive?
SpecialFolders (MSDN):
Dim objShell As Object
Dim strPath As String
Set objShell = Wscript.CreateObject("Wscript.Shell")
strPath = objShell.SpecialFolders("MyDocuments")
wscript.echo strPath
or optionally:
Set S = CreateObject("WScript.Shell")
Set E = S.Environment
WScript.Echo E("USERPROFILE")
Related
In continuation of Call VBScript from Windows Explorer Context Menu, I managed to get a VBScript file running from SendTo in the Windows Explorer.
I've changed my code to copy the file that invokes the script to my Temp folder. The new problem is that if the path is over 256 characters, I can't loop through WScript.Arguments to get all of it. Is there another way to get the full path (including the file name and it's extension)?
Option Explicit
Call OpenDocuWorksFile
Sub OpenDocuWorksFile()
Const sTitle = "Open DocuWorks File"
Dim iArgumentsCount
Dim iArgument
Dim sFilePath
Dim sTempFolder
Dim oFileScriptingObject
Dim sFileName
Dim oShell
iArgumentsCount = WScript.Arguments.Count
On Error Resume Next
For iArgument = 0 To iArgumentsCount
sFilePath = sFilePath & WScript.Arguments(iArgument)
Next
On Error GoTo 0
Set oFileScriptingObject = CreateObject("Scripting.FileSystemObject")
With oFileScriptingObject
sFileName = .GetFileName(sFilePath)
sTempFolder = oFileScriptingObject.GetSpecialFolder(2) 'Temp Folder
If .GetExtensionName(sFileName) = "xdw" Then
.CopyFile sFilePath, sTempFolder & "\", True 'Overwrite
Set oShell = CreateObject("Shell.Application")
oShell.Open sTempFolder & "\" & sFileName
Else
MsgBox "Please select a DocuWorks file.（.xdw)", vbCritical, sTitle
End If
End With
Set oFileScriptingObject = Nothing
Set oShell = Nothing
End Sub
I was just wondering if there was a way to get the length of an mp3 file in seconds through VBScript into a variable.
(Adapted from my answer to a similar question about JScript.)
You can use the GetDetailsOf method of the Windows Shell Folder object to get the audio file length. This technique supports all audio file types whose metadata can be read and displayed by Windows Explorer natively.
However, note that the index of the Length attribute is different on different Windows versions: it's 21 on Windows XP/2003 and 27 on Windows Vista+. See this page and this my answer for details. You will need to take this into account in your script.
Example code:
Const LENGTH = 27 ' Windows Vista+
' Const LENGTH = 21 ' Windows XP
Dim oShell : Set oShell = CreateObject("Shell.Application")
Dim oFolder : Set oFolder = oShell.Namespace("C:\Music")
Dim oFile : Set oFile = oFolder.ParseName("Track.mp3")
Dim strLength : strLength = oFolder.GetDetailsOf(oFile, LENGTH)
WScript.Echo strLength
Example output:
00:05:18
Using Windows Media Player Control library is another way. Before using this make sure the path is correct.
Function MediaDuration(path)
With CreateObject("Wmplayer.OCX")
.settings.mute = True
.url = path
Do While Not .playState = 3 'wmppsPlaying
WScript.Sleep 50
Loop
MediaDuration = Round(.currentMedia.duration) 'in seconds
'MediaDuration = .currentMedia.durationString 'in hh:mm:ss format
.Close
End With
End Function
WScript.Echo MediaDuration("C:\media\song.mp3")
Set objShell = CreateObject("Shell.Application")
Set Ag=Wscript.Arguments
set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\App Paths\" & Wscript.ScriptName & "\", Chr(34) & Wscript.ScriptFullName & Chr(34)
WshShell.RegWrite "HKLM\Software\Microsoft\Windows\CurrentVersion\App Paths\" & Left(Wscript.ScriptName, Len(Wscript.ScriptName)-3) & "exe" & "\", Chr(34) & Wscript.ScriptFullName & Chr(34)
Set Fldr=objShell.NameSpace(Ag(0))
Set FldrItems=Fldr.Items
Set fso = CreateObject("Scripting.FileSystemObject")
Set DeskFldr=objShell.Namespace(16)
FName=fso.buildpath(DeskFldr.self.path, "Folder Property List.txt")
Set ts = fso.OpenTextFile(FName, 8, vbtrue)
For x = 0 to 50
t1 = t1 & Fldr.GetDetailsOf(vbnull, x) & " (Shell)" & vbtab
Next
ts.write FLDR.self.path &vbcrlf
ts.Write T1 & vbcrlf
T1=""
For Each FldrItem in FldrItems
For x = 0 to 50
t1 = t1 & Fldr.GetDetailsOf(FldrItem, x) & vbtab
Next
t1=t1 & vbcrlf
ts.Write T1
T1=""
Next
'msgbox FName & "has a tab delimited list of all properties"
If you drop a folder on the above it will generate a list of all shell properties for files in the folder. I don't have any mp3 files. It will depend on what software you have installed as to what will happen. Wma files leave duration blank. And the properties change dramatically from Windows version to version.
The first loop gets the properties that are available (by passing null for folderitem), the second the properties for each folderitem.
I'm trying to create a zip file, then copy three folders into it. I get the error on line 33 char 1, error state object required, I have searched and googled but just can't seem to either understand what I'm reading or understand what I really need to search for. Anyhow, here is my code.
Option Explicit
Dim objFSO, objFolder1, objFolder2, objFolder3, FolderToZip, ziptoFile, FolderGroup
Dim ShellApp, eFile, oNewZip, strZipHeader
Dim ZipName, Folder, i, Zip, Item
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder1 = objFSO.GetFolder("C:\Windows\Temp\SMSTSLog")
Set objFolder2 = objFSO.GetFolder ("C:\Windows\System32\CCM\Logs")
Set objFolder3 = objFSO.GetFolder ("C:\Windows\SysWOW64\CCM\Logs")
'For Each efile In objFolder.Files
' If DateDiff("d",eFile.DateLastModified,Now) >= 2 Then
' objFSO.MoveFile eFile, "C:\Documents and Settings\User\Desktop\Test2\"
' End If
'Next
Wscript.Sleep 2000
Set oNewZip = objFSO.OpenTextFile("C:\win7tools\testing script.zip", 8, True)
strZipHeader = "PK" & Chr(5) & Chr(6)
For i = 0 To 17
strZipHeader = strZipHeader & Chr(0)
Next
oNewZip.Write strZipHeader
oNewZip.Close
Set oNewZip = Nothing
WScript.Sleep 5000
FolderGroup = Array(objFolder1,objFolder2,objFolder3)
FolderToZip = "FolderGroup"
ZipToFile = "C:\Win7tools\Test Script.zip"
Set ShellApp = CreateObject("Shell.Application")
Set Zip = ShellApp.NameSpace(ZipToFile)
'Set Folder = ShellApp.NameSpace(FolderToZip)
ShellApp.NameSpace(FolderGroup).CopyHere Zip.NameSpace(ZipToFile)
WScript.Sleep 10000
set ShellApp = Nothing
set FolderToZip = Nothing
set ZipToFile = Nothing
When in doubt, read the documentation:
retVal = Shell.NameSpace(
vDir
)
Parameters
vDir [in]
Type: Variant
The folder for which to create the Folder object. This can be a string that specifies the path of the folder or one of the ShellSpecialFolderConstants values. Note that the constant names found in ShellSpecialFolderConstants are available in Visual Basic, but not in VBScript or JScript. In those cases, the numeric values must be used in their place.
The NameSpace method expects either a string with a path or the integer value of one of the ShellSpecialFolderConstants, not an array of Folder objects. Also you got the order wrong. The object on which you call the copyHere method is the zip file. The argument is what you want to copy to the zip file (a path string should do just fine here). Plus, the name of the zip file you create is different from the name of the zip file you try to add the folders to.
Change your code to this:
folder1 = "C:\Windows\Temp\SMSTSLog"
folder2 = "C:\Windows\System32\CCM\Logs"
folder3 = "C:\Windows\SysWOW64\CCM\Logs"
zipfile = "C:\Win7tools\Test Script.zip"
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.OpenTextFile(zipfile, 2, True).Write "PK" & Chr(5) & Chr(6) _
& String(18, Chr(0))
Set ShellApp = CreateObject("Shell.Application")
Set zip = ShellApp.NameSpace(zipfile)
zip.CopyHere folder1
zip.CopyHere folder2
zip.CopyHere folder3
WScript.Sleep 10000
WinZip has a Command Line Interface. You might have to download and install it depending on your version: http://www.winzip.com/prodpagecl.htm
The below is a test script that works for WinZip version 9.0 if it helps.
Const WinZip = "C:\Program Files\WinZip9.0\wzzip.exe" 'WinZip Version 9.0
BasePath = "C:\Path\To\Folders\"
strZipFilePath = BasePath & "Test.zip"
strArchiveMe = BasePath & "Folder_A"
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not objFSO.FileExists(WinZip) Then
MsgBox "WinZip (wzzip.exe) Does Not Exist"
WScript.Quit
End If
'''// For Below Command - Change "-a" TO "-mu" To Auto Delete The file After Zip Is Created
'''// For Below Command - Change "-yb" TO "-ybc" To Answer YES To all Promps and not Terminate Operation
strcommand = Chr(34) & WinZip & Chr(34) & " -a -yb " & Chr(34) & strZipFilePath & Chr(34) & " " & Chr(34) & strArchiveMe & Chr(34)
objShell.Run strcommand, 1, True
The command format is:
winzip [action] [options] [Zip Path] [Path to file/folder to zip]
I work in a hospital environment and right now im doing PC deployments. Part of the deployment requires us to view 2 files on a network drive looking for information regarding the old systems. They use specific ports and or TTY's to view information in each department.
I am trying to create a VBS file that can open 2 files in 2 different notepad windows. The first one opens up but the pcview.cfg keeps giving me an error. Im trying to link to the same location that the HBOWEM32 is pointed to. Can anyone solve? For security reasons I have taken out the exact location of the network drive. The code below prompts for a specific folder name which is the old pc name. After entering that data it opens the HBOWEM32 files fine but says it cannot find the other part. I Have manually looked inside the folder and the pcview.cfg file DOES exist. I just want a faster way of opening these rather than brute forcing through the run prompt.
Here is the code.
CONST strDir = "<Netowrk Location)"
Dim WshShell
set objShell = CreateObject("WScript.Shell")
set objFSO = CreateObject("Scripting.FileSystemObject")
function findFolder(strDir, strFlag)
set objFolder = objFSO.GetFolder(strDir)
for each objSubFolder in objFolder.SubFolders
if (inStr(objSubFolder.Name, strFlag)) then
findFolder = objSubFolder.Path
exit function
else
findFolder = findFolder (objSubFolder.Path, strFlag)
end if
next
end function
strFlag = inputBox("Enter Computer Name:")
strWeb = findFolder(strDir, strFlag) & "\HBOWEM32.ini"
objShell.Run strWeb
Set WshShell = CreateObject ("WScript.Shell")
WshShell.Run ("notepad.exe """ + "\\<same location as above>\Pcview.cfg""")
Use Option Explicit
Don't create variables you don't use (WshShell, objShell)
Improve your variable names (strFlag seems to be a computer name, strWeb seems to be the full specification of a file)
Don't lump different info into one variable (strWeb contains the folder path to re-use and the specific file name)
Use diagnostics output (at least while developing)
In code:
Option Explicit
...
Dim strComputer : strComputer = InputBox("Enter Computer Name:")
Dim strFolder : strFolder = findFolder(strDir, strComputer)
Dim strIniFSpec : strIniFSpec = objFSO.BuildPath(strFolder, "HBOWEM32.ini")
WScript.Echo "will run '" & strIniFSpec & "'"
objShell.Run strIniFSpec
Dim WshShell : Set WshShell = CreateObject("WScript.Shell")
Dim strCfgFSpec : strCfgFSpec = objFSO.BuildPath(strFolder, "Pcview.cfg")
Dim strCmd : strCmd = "notepad.exe """ & strCfgFSpec & """"
WScript.Echo "will run '" & strCmd & "'"
WshShell.Run strCmd
(not tested, please be carefull)
I'm having a problem with Trend OfficeScan Patterns filling up the C:\ drive (no other drives available to change directories) and I'm getting a permission denied error accessing "C:\Program Files\Trend Micro\OfficeScan\PCCSRV\WSS\patterns" running the below script. As I'll be using this script for a few sites, and to make it easy to implement for my colleagues, I don't want to play around adding various permissions.
I tried changing: PatternLocation = (strValue & "WSS\patterns\") to PatternLocation = ("""" & strValue & "WSS\patterns\""") and I get 'Path not found'. Are there any VBScript experts that may be able to recommend an impersonate method to overcome the permissions denied?
' Variable to locate HLM.
const HKEY_LOCAL_MACHINE = &H80000002
Set fso = CreateObject("Scripting.FileSystemObject")
' Checks if the operating system is x86 or x64
Set objShell = CreateObject("WScript.Shell")
osType = objShell.ExpandEnvironmentStrings("%PROCESSOR_ARCHITECTURE%")
' The dot refers to the computer this vbscript has been run on.
strComputer = "."
' Provides connection to the registry.
Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &_
strComputer & "\root\default:StdRegProv")
' Checks the bit for the operating system
If osType = "x86" Then
' Checks registry for Trend folder path.
strKeyPath = "SOFTWARE\TrendMicro\OfficeScan\Service\Information"
Elseif osType = "AMD64" Then
strKeyPath = "SOFTWARE\Wow6432Node\TrendMicro\OfficeScan\service\Information"
End if
trValueName = "Local_Path"
objReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
' If the registry path is empty it won't install the scheduled task and alert you.
If IsNull(strValue) Then
msgbox("Trend Micro is not installed.")
else
PatternLocation = (strValue & "WSS\patterns\") ' folder to start deleting (subfolders will also be cleaned)
OlderThanDate = DateAdd("d", -2, Date) ''# 2 days (adjust as necessary)
DeleteOldFiles PatternLocation, OlderThanDate
end if
Function DeleteOldFiles(folderName, BeforeDate)
Dim folder, file, fileCollection, folderCollection, subFolder
Set folder = fso.GetFolder(folderName)
Set fileCollection = folder.Files
For Each file In fileCollection
If file.DateLastModified < BeforeDate Then
fso.DeleteFile(file.Path)
End If
Next
Set folderCollection = folder.SubFolders
For Each subFolder In folderCollection
DeleteOldFiles subFolder.Path, BeforeDate
Next
End Function
This is the working script with a few changes for anyone who might find it useful:
'Variable to locate HLM.
const HKEY_LOCAL_MACHINE = &H80000002
Set fso = CreateObject("Scripting.FileSystemObject")
'Checks if the operating system is x86 or x64
Set objShell = CreateObject("WScript.Shell")
osType = objShell.ExpandEnvironmentStrings("%PROCESSOR_ARCHITECTURE%")
'The dot refers to the computer this vbscript has been run on.
strComputer = "."
'Provides connection to the registry.
Set objReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &_
strComputer & "\root\default:StdRegProv")
'Checks the bit for the operating system
If osType = "x86" Then
'Checks registry for Trend folder path.
strKeyPath = "SOFTWARE\TrendMicro\OfficeScan\Service\Information"
Elseif osType = "AMD64" Then
strKeyPath = "SOFTWARE\Wow6432Node\TrendMicro\OfficeScan\service\Information"
End if
strValueName = "Local_Path"
objReg.GetStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue
'If the registry path is empty it won't install the scheduled task and alert you.
If IsNull(strValue) Then
msgbox("Trend Micro is not installed.")
else
PatternLocation = (strValue & "WSS\patterns") ' folder to start deleting (subfolders will also be cleaned)
'msgbox(PatternLocation)
end if
startFolder = PatternLocation
OlderThanDate = DateAdd("d", -1, Date) ' 1 days
DeleteOldFiles startFolder, OlderThanDate
DeleteEmptyFolders startFolder
Function DeleteOldFiles(folderName, BeforeDate)
Dim folder, file, fileCollection, folderCollection, subFolder
Set folder = fso.GetFolder(folderName)
Set fileCollection = folder.Files
For Each file In fileCollection
If file.DateLastModified < BeforeDate Then
fso.DeleteFile(file.Path)
End If
Next
Set folderCollection = folder.SubFolders
For Each subFolder In folderCollection
DeleteOldFiles subFolder.Path, BeforeDate
Next
End Function
Function DeleteEmptyFolders(foldername)
For Each Folder In fso.GetFolder(foldername).SubFolders
DeleteEmptyFolders(Folder.Path)
If Folder.Files.Count = 0 and Folder.SubFolders.Count = 0 Then
fso.DeleteFolder(Folder.Path)
End If
Next
End Function