On Error Resume Next
'Setup objects
Dim oWSH: Set oWSH = WScript.CreateObject("WScript.Shell")
Dim oFSO: Set oFSO = WScript.CreateObject("Scripting.FileSystemObject")
Dim oWSHL
'Find the Start Menu startup folder
Dim startup: startup = oWSH.SpecialFolders("Startup")
'-Either- Find the start location of the script (if run from server)
Dim source: source = Replace(WScript.ScriptFullName,"\" & WScript.ScriptName,"")
'-OR- Hardcode the path of the source (if run from local machine)
'Dim source: source = "\\server\share\folder"
'Find the program files folder then append the install folder
Dim target: target = oWSH.RegRead("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\ProgramFilesDir") & "\BGInfo"
Dim copyExe, copyBgi
'Create Target Folder
If CreateFolder(target) Then
'Copy Files
oFSO.CopyFile source & "\bginfo.exe", target & "\bginfo.exe", True
oFSO.CopyFile source & "\bginfo.bgi", target & "\bginfo.bgi", True
If oFSO.FileExist(source & "\bginfo.exe") AND oFSO.FileExist(source & "\bginfo.bgi") Then
'Create shortcut
Set oWSHL = oWSH.CreateShortcut(startup & "\Run BGInfo.lnk")
With oWSHL
.TargetPath = target & "\bginfo.exe"
.Arguments = Chr(34) & target & "\bginfo.bgi" & Chr(34) & " /timer:0"
.IconLocation = target & "\bginfo.exe, 0"
.Description = "Runs Background Info from SysInternals"
.WorkingDirectory = target
.Save
End With
Set oWSHL = Nothing
Else
'MsgBox "Failed to copy a file" & vbcrlf & vbcrlf & err.description
End If
Else
'MsgBox "Failed to create folder: " & target & vbcrlf & vbcrlf & err.description
End If
'Clean up
Set oWSH = Nothing
Set oFSO = Nothing
MsgBox "Done"
WScript.Quit
Function CreateFolder(folderName)
On Error Resume Next
Dim aFolders: aFolders = Split(folderName,"\")
Dim i
Dim currentFolder
For i = LBound(aFolders) to UBound(aFolders)
currentFolder = currentFolder & aFolders(i) & "\"
If NOT oFSO.FolderExists(currentFolder) Then
oFSO.CreateFolder(currentFolder)
End If
Next 'i
If oFSO.FolderExists(folderName) Then
CreateFolder = True
Else
CreateFolder = False
End If
End Function