vbscript filesystemobject permission denied - vbscript

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

Related

Why can't I copy a file to a location using an environment variable?

I have this code that copies outlook PST files, and when used with the full location file path it runs perfectly fine. I've added a method to run %UserProfile% in the first line as this needs to be run in a domain context from GPO and doing it individually is non-feasible. This runs and closes outlook and reopens it at the appropriate time except one thing is amiss.
It is no longer copying the appropriate files. I echoed the initial %userprofile% sections and it is reading the correctly as "drive letter"\users\userprofile. I'm not sure where this is breaking or how to identify it.
'===================BEGIN MODIFY====================================
Set objShell = CreateObject("WScript.Shell")
userProfilePath = objShell.ExpandEnvironmentStrings("%UserProfile%")
'Set the amount of pst-files you want to copy. Start counting at 0!
ReDim pst(1)
'Define the location of each pst-file to backup. Increase the counter!
pst(0) = "%UserProfile%\AppData\Local\Microsoft\Outlook\PST\Outlook Data File - mike.pst"
pst(1) = "%UserProfile%\AppData\Local\Microsoft\Outlook\PST\Archive.pst"
'Define your backup location
BackupPath = "%UserProfile%\Documents\Outlook Backups\"
'Keep old backups? TRUE/FALSE
KeepHistory = FALSE
'Maximum time in milliseconds for Outlook to close on its own
delay = 30000 'It is not recommended to set this below 8000
'Start Outlook again afterwards? TRUE/FALSE
start = TRUE
'===================STOP MODIFY====================================
'Close Outlook
Call CloseOutlook(delay)
'Outlook is closed, so we can start the backup
Call BackupPST(pst, BackupPath, KeepHistory)
'Open Outlook again when desired.
If start = TRUE Then
Call OpenOutlook()
End If
Sub CloseOutlook(delay)
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
'If Outlook is running, let it quit on its own.
For Each Process in objWMIService.InstancesOf("Win32_Process")
If StrComp(Process.Name,"OUTLOOK.EXE",vbTextCompare) = 0 Then
Set objOutlook = CreateObject("Outlook.Application")
objOutlook.Quit
WScript.Sleep delay
Exit For
End If
Next
'Make sure Outlook is closed and otherwise force it.
Set colProcessList = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = 'Outlook.exe'")
For Each objProcess in colProcessList
objProcess.Terminate()
Next
Set objWMIService = Nothing
Set objOutlook = Nothing
set colProcessList = Nothing
End Sub
Sub BackupPST(pst, BackupPath, KeepHistory)
Set fso = CreateObject("Scripting.FileSystemObject")
If KeepHistory = True Then
ArchiveFolder = Year(Now) & "-" & Month(Now) & "-" & Day(Now)
BackupPath = BackupPath & ArchiveFolder & "\"
End If
For Each pstPath in pst
If fso.FileExists(pstPath) Then
fso.CopyFile pstPath, BackupPath, True
End If
Next
Set fso = Nothing
End Sub
Sub OpenOutlook()
Set objShell = CreateObject("WScript.Shell")
objShell.Run "Outlook.exe"
End Sub
When you declared userProfilePath = objShell.ExpandEnvironmentStrings("%UserProfile%"), you put the path of %UserProfile% in the variable named userProfilePath, but afterward you don't use this variable. That's a problem, because a few lines down, what you end up doing is declaring pst(#) with %userprofile% as a string, which doesn't work.
In other words, the %UserProfile% environment path/string needs to be expanded before being used as a path.
Your code would work if you used the userProfilePath variable you declared:
'Define the location of each pst-file to backup. Increase the counter!
pst(0) = userProfilePath+"\AppData\Local\Microsoft\Outlook\PST\Outlook Data File - mike.pst"
pst(1) = userProfilePath+"\AppData\Local\Microsoft\Outlook\PST\Archive.pst"
'Define your backup location
BackupPath = userProfilePath"\Documents\Outlook Backups\"
instead of
'Define the location of each pst-file to backup. Increase the counter!
pst(0) = "%UserProfile%\AppData\Local\Microsoft\Outlook\PST\Outlook Data File - mike.pst"
pst(1) = "%UserProfile%\AppData\Local\Microsoft\Outlook\PST\Archive.pst"
'Define your backup location
BackupPath = "%UserProfile%\Documents\Outlook Backups\"

vbs script works on 86 but fails on 64

the script works on x86 but doesnt create the file on x64.
Can anyone understand why and explain?
The script is searching the registry, Uninstall key and checking for displayname equal to what im searching for, and grabbing the productcode, and saving to a file which then copies to a remote share i have set up.
On error resume Next
Dim strName, WshShell, oReg, keyname, WshNetwork, ComputerName
Set fso = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
Set WshNetwork = WScript.CreateObject("WScript.Network")
Const HKEY_LOCAL_MACHINE = &H80000002
Const ForReading = 1, ForWriting = 2, ForAppending = 8
ComputerName = WshNetwork.ComputerName
FileName = ComputerName & "_data.txt"
'FileName = "sep_data.txt"
'=============================================
'Chage the value here with DisplayName's value
strName = "Symantec Endpoint Protection"
'=============================================
'currentDirectory = Left(WScript.ScriptFullName,(Len(WScript.ScriptFullName))-(Len(WScript.ScriptName)))
currentDirectory = "c:\windows\temp\"
'set location in registry we want to get data from
Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & ComputerName & "\root\default:StdRegProv")
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
'check each key in uninstall for any display name called Symantec Endpoint Protection
For Each subkey In arrSubKeys
keyname = ""
keyname = wshshell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\" & subkey & "\DisplayName")
If keyname = strName then
i = subkey
End If
' Writes text to file if it exists
If i Then
'open text file for writing
Set filetxt = fso.OpenTextFile(currentDirectory & FileName, 2, True)
'write to text file
filetxt.WriteLine "" & computerName & "," & i & ""
'Close file
filetxt.Close
'Copy file to network share
fso.CopyFile "c:\windows\temp\" & FileName & "", "\\hostname\test\", true
End If
Next
Set WshShell = Nothing
Set ObjReg = Nothing
Set computerName = Nothing
Set i = Nothing
WScript.Quit
Here you can find why (in short there are separate structures for 32 and 64 bits in the registry and the file system access is redirected)
For a how, if the application/registry is 32 bit, start the script using the 32 bit script host version (in 64b OS versions, the 32b executables are under %systemroot%\SysWOW64)
"%systemroot%\SysWOW64\cscript.exe" myscript.vbs
The inverse problem, you have a 32 bits process but you need to access the 64 bit registry, requires the start of a 64 bit process, and here things change.
While the executables in %systemroot%\System32 are 64 bits, as the current process is 32 bits it is running under a registry and file system redirection and any reference to %systemroot%\System32 in converted to a reference to %systemroot%\SysWOW64 (32bit processes expect a 32bit OS). This can be solved using
"%systemroot%\sysnative\cscript.exe" myscript.vbs
Yes, if you search the sysnative folder from a 64 bit process you will not find it, but from a 32 bit process it gives you access to the 64 bit system32 folder.
edited to include a workaround. The basic idea is to try to find the required information using the current engine. If not found, the script relaunches itself with a different host.
Option Explicit
Const HKEY_LOCAL_MACHINE = &H80000002
Const ForReading = 1 _
, ForWriting = 2 _
, ForAppending = 8
Const UNINSTALL_KEY_PATH = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
Const KEY_DISPLAY_NAME = "Symantec Endpoint Protection"
Const TARGET_FOLDER = "C:\TEMP"
Const ARGUMENT_FLAG = "_CHILD_"
Dim shell
Set shell = WScript.CreateObject("WScript.Shell")
Dim retValue, alternateHost
If Not WScript.Arguments.Named.Exists(ARGUMENT_FLAG) Then
retValue = shell.Run( quote(WScript.FullName) & " " & quote(WScript.ScriptFullName) & " /" & ARGUMENT_FLAG, 0, True )
If retValue > 0 Then
With WScript.CreateObject("Scripting.FileSystemObject")
If .GetFile( WScript.FullName ).ParentFolder.Name = "SysWOW64" Then
alternateHost = "\sysnative\"
Else
alternateHost = "\SysWOW64\"
End If
alternateHost = .BuildPath( shell.ExpandEnvironmentStrings("%systemroot%") & alternateHost, "cscript.exe" )
If .FileExists( alternateHost ) Then
Call shell.Run( quote(alternateHost) & " " & quote(WScript.ScriptFullName) & " /" & ARGUMENT_FLAG, 0, True )
End If
End With
End If
WScript.Quit
End If
Dim reg
Set reg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
Dim subKeys, subKey, value, keyFound
keyFound = False
reg.EnumKey HKEY_LOCAL_MACHINE, UNINSTALL_KEY_PATH, subKeys
For Each subKey In subKeys
reg.GetStringValue HKEY_LOCAL_MACHINE, UNINSTALL_KEY_PATH & "\" & subkey , "DisplayName", value
If Not IsNull( value ) Then
If value = KEY_DISPLAY_NAME Then
keyFound = True
Exit For
End If
End If
Next
Dim computerName, baseName, fileName, exitCode
If keyFound Then
computerName = WScript.CreateObject("WScript.Network").ComputerName
baseName = computerName & "_data.txt"
With WScript.CreateObject("Scripting.FileSystemObject")
fileName = .BuildPath( shell.ExpandEnvironmentStrings("%temp%"), baseName )
.CreateTextFile( fileName, True ).WriteLine( computerName & "," & KEY_DISPLAY_NAME )
.CopyFile fileName, .BuildPath( TARGET_FOLDER, .GetFile( fileName ).Name )
End With
exitCode = 0
Else
exitCode = 1
End If
Call WScript.Quit( exitCode )
Function quote( text )
quote = """" & text & """"
End Function
i used an alternative method to move the file to a share. why the 64 bit os was getting missed was due to my reg query call. it was missing /reg64 at the end.

How can I delete %appdata%, etc.. folders remotely from a txt list of computers?

I am trying to delete multiple folders that will be read from a txt file. I am not sure how to get it to loop through the computers in the text file while pulling the currently logged on user. I tried some code but not experience enough to merge it with what I currently have.
I have a working script that deletes folders from a list of computers in a txt file except for the ones with %APPDATA%, etc... which is why I am using vbscript.
Just to note, I am unable to use any software other than what comes installed with Windows 7. This eliminates psexec, etc...
Any help would be greatly appreciated, thanks!
InputFile = "C:\complist.txt"
Const DeleteReadOnly = True
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFile = objFSO.OpenTextFile(InputFile)
Do While Not (objFile.AtEndOfStream)
strComputer = objFile.ReadLine
On Error Resume Next
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFolder("\\" & strComputer & "\c$\test")
objFSO.DeleteFolder("\\" & strComputer & "\c$\%APPDATA%\PGP Corporation")
objFSO.DeleteFolder("\\" & strComputer & "\c$\%LOCALAPPDATA%\PGP Corporation")
objFSO.DeleteFolder("\\" & strComputer & "\c$\%USERPROFILE%\Documents\PGP Corporation")
objFSO.DeleteFolder("\\" & strComputer & "\c$\%ALLUSERSPROFILE%\Application Data\PGP Corporation")
objFSO.DeleteFolder("\\" & strComputer & "\c$\%ALLUSERSPROFILE%\Start Menu\Programs\PGP")
objFSO.DeleteFolder("\\" & strComputer & "\c$\%CommonProgramFiles%\PGP Corporation")
objFSO.DeleteFolder("\\" & strComputer & "\c$\%ProgramFiles%\PGP Corporation")
objFSO.DeleteFolder("\\" & strComputer & "\c$\Windows\System32\config\systemprofile\AppData\Local\PGP Corporation")
Err.clean
Loop
MsgBox "Done"
First and foremost, environment variables don't work in FileSystemObject methods. At all. You need to expand them to actual paths, e.g. like this:
Set sh = CreateObject("WScript.Shell")
dir = sh.ExplandEnvironmentStrings("\\" & strComputer & "\c$\%APPDATA%\PGP Corporation")
objFSO.DeleteFolder dir
Also, the variables are local to the user and system running the script, i.e. the above would resolve %APPDATA% of your user on the system where you run the script, not on the system specified by strComputer. You'd need to read the variables from the registry of the remote host, e.g. like this:
Set reg = GetObject("winmgmts://" & strComputer & "/root/default:StdRegProv")
HKLM = &h80000002
key = "SOFTWARE\Microsoft\Windows\CurrentVersion"
vn = "CommonFilesDir"
rc = reg.GetStringValue(HKLM, key, vn, val)
If rc = 0 Then
commonProgramFiles = val
Else
WScript.Echo "Cannot read value from remote registry (" & rc & ")."
End If
Also, the location where/how some of the variables (specifically %ALLUSERSPROFILE%) are stored in the registry differs across Windows versions. In Windows XP %ALLUSERSPROFILE% is a combination of the 2 registry values ProfilesDirectory and AllUsersProfile, whereas in Windows 7 it's derived from the registry value ProgramData (all located in HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList).
And last, but not least, several of your variables are user-specific (namely %APPDATA%, %LOCALAPPDATA% and %USERPROFILE%), so you'd need to process them for each user on the remote host.
An (arguably less precise, but more straightforward) approach would be to read the location of the profile folder from the remote registry and then process all subfolders of that folder on the remote host.
Set reg = GetObject("winmgmts://" & strComputer & "/root/default:StdRegProv")
HKLM = &h80000002
key = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList"
vn = "ProfilesDirectory"
rc = reg.GetStringValue(HKLM, key, vn, profilesDir)
If rc <> 0 Then
WScript.Echo "Cannot read profiles directory remote registry (" & rc & ")."
WScript.Quit rc
End If
'ugly workaround, b/c %SystemDrive% cannot be determined from the registry
profilesDir = Replace(profilesDir, "%SystemDrive%", "C$")
Set fso = CreateObject("Scripting.FileSystemObject")
For Each sf In fso.GetFolder("\\" & strComputer & "\" & profilesDir).SubFolders
dir = fso.BuildPath(sf.Path, "Documents")
If fso.FolderExists(dir) Then fso.DeleteFolder dir
...
Next

how to add a log to my vbscript

i have this script that reads a list of computers and check to see if the computers have the right software version install. the script echo to me the computers with the wrong version, but i want to make a log instead
Dim strComputer, objFSO, ObjShell, strDisplayName, objList, strObject
Dim objReg, arrSubKeys, strProduct, strVersion, strReqVersion
Const For_Writing = 2
Const ForReading = 1
const ForAppending = 3
Const HKLM = &H80000002
Const strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"
strReqVersion = "8.2.1 MP2"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")
Set objList = objFSO.OpenTextFile("c:\test\test.txt",ForReading)
Do While Not objList.AtEndOfStream
strComputer = objList.ReadLine
If HostOnline(strComputer) = True Then
Inventory(strComputer)
End If
Loop
Function Inventory(strComputer)
Set objTextFile = objFSO.OpenTextFile("c:\test\inventory.txt",2,true)
'creating a dictionary object
Set objDictionary = CreateObject("Scripting.Dictionary")
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
' Enumerate the subkeys of the Uninstall key
objReg.EnumKey HKLM, strKeyPath, arrSubKeys
For Each strProduct In arrSubKeys
' Get the product's display name
objReg.GetStringValue HKLM, strKeyPath & "\" & strProduct, "DisplayName", strDisplayName
' Process only products whose name contain 'symantec'
If InStr(1, strDisplayName, "Symantec", vbTextCompare) > 0 Then
' Get the product's display version
objReg.GetStringValue HKLM, strKeyPath & "\" & strProduct, "DisplayVersion", strVersion
If strReqVersion <> strVersion Then
WScript.Echo strObject
objDictionary.Add strComputer, strVersion
For Each strObject In objDictionary
WScript.Echo strObject
objTextFile.WriteLine(strObject)
Next
objTextFile.Close
End If
End If
Next
End Function
Function HostOnline(strComputername)
'---------- Test to see if host or url alive through ping -----------------
' Returns True if Host responds to ping
'
' strComputername is a hostname or IP
Const OpenAsASCII = 0
Const FailIfNotExist = 0
Const ForReading = 1
Dim objShell, objFSO, sTempFile, fFile
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
sTempFile = objFSO.GetSpecialFolder(2).ShortPath & "\" & objFSO.GetTempName
objShell.Run "cmd /c ping -n 2 -l 8 " & strComputername & ">" & sTempFile, 0 , True
Set fFile = objFSO.OpenTextFile(sTempFile, ForReading, FailIfNotExist, OpenAsASCII)
Select Case InStr(fFile.ReadAll, "TTL=")
Case 0
HostOnline = False
Case Else
HostOnline = True
End Select
ffile.close
objFSO.DeleteFile(sTempFile)
Set objFSO = Nothing
Set objShell = Nothing
End Function
can some one help me please thanks
There are several ways to do this. The simplest way, without any modification to your script, would be to call the script with cscript.exe (in a command prompt) and redirect the output to a file:
cscript your.vbs > output.log
However, if you want a log to be created even when users double-click your script you'll have to change your script so that it writes to a file instead of echoing the output. Open the log file at the beginning of the script:
Set myLog = objFSO.OpenTextFile("C:\my.log", For_Writing, True)
replace WScript.Echo ... with myLog.WriteLine ..., and close the file before you exit from the script:
myLog.Close
A somewhat more sophisticated approach would be to create a set of logging functions, which will allow you create log lines depending on certain conditions, e.g. LogInfo() for informational log messages and LogError() for errors.
Shameless plug: Some time ago I got fed up with writing the same boilerplate logging functions over and over again, so I wrote a logger class that encapsulates the usual logging facilities (interactive console, files, eventlog) and provides logging methods for 4 log levels (Error, Warning, Information, Debug). The class can be used for logging to a file like this:
Set myLog = New CLogger
myLog.LogToConsole = False
myLog.LogFile = "C:\my.log"
myLog.LogInfo "info message"
...
myLog.LogError "an error occurred"
The log file is automatically closed when the object is released.
Why not use the system's event log? I described how in this answer
It means most of the work is done for you and you don't need to worry about where to put your log file

Installation script issue for shifting folder structure

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")

Resources