Vb Script to check operating system and copy files using environmental folders
o.s check....
0 Comments
[ + ] Show comments
Answers (6)
Please log in to answer
Posted by:
AngelD
14 years ago
Why complicate it?
Use the below instead:
Set WshShell = CreateObject("WScript.Shell")
DesktopFolder = WshShell.SpecialFolders("Desktop")
StartMenuProgramsFolder = WshShell.SpecialFolders("Programs")
Use the below instead:
Set WshShell = CreateObject("WScript.Shell")
DesktopFolder = WshShell.SpecialFolders("Desktop")
StartMenuProgramsFolder = WshShell.SpecialFolders("Programs")
Posted by:
anonymous_9363
14 years ago
I don't know about others but I generally get paid for work that I do: I don't do it for free. All the information you need is ON THIS PAGE. :-)
Posted by:
WSPPackager
14 years ago
Hi Harsha,
I would suggest to use UNC path instead of Mapped drive letter T.
Let me know if that works or not?
Regards,
I would suggest to use UNC path instead of Mapped drive letter T.
Let me know if that works or not?
Regards,
Posted by:
AngelD
14 years ago
Option Explicit
Const FileToCopy = "T:\Apps\5081-Pin2.2_Vista\PIN2_2.lnk"
Const DepartAppFolderName = "Departmental Applications"
Dim desktopFolder, startMenuProgramsFolder, destPath
'// Get special folders
If (Not GetSpecialFolderPath("Desktop", desktopFolder)) Then
'// failed to get path for special folder (ex. C:\Users\AngelD\Desktop)
WScript.Quit(1)
End If
If (Not GetSpecialFolderPath("Programs", startMenuProgramsFolder)) Then
'// failed to get path for special folder (ex. C:\Users\AngelD\AppData\Roaming\Microsoft\Windows\Start Menu\Programs)
WScript.Quit(1)
End If
If (Not FileExists(FileToCopy)) Then
'// file to copy does not exist
WScript.Quit(1)
End If
If (Not CreateDirectoryPath(BuildPath(startMenuProgramsFolder, DepartAppFolderName))) Then
'// failed to create folder (ex. C:\Users\AngelD\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\Departmental Applications)
WScript.Quit(1)
End If
destPath = desktopFolder
If (Not CopyFile(FileToCopy, BuildPath(destPath, "\"), true)) Then
'// failed to copy or overwrite file to destination (ex. C:\Users\AngelD\Desktop\)
WScript.Quit(1)
End If
destPath = BuildPath(startMenuProgramsFolder, DepartAppFolderName)
If (Not CopyFile(FileToCopy, BuildPath(destPath, "\"), true)) Then
'// failed to copy or overwrite file to destination (ex. C:\Users\AngelD\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\Departmental Applications\)
WScript.Quit(1)
End If
WScript.Quit(0)
Function FileExists(ByVal filePath)
Dim oFso
FileExists = false
Set oFso = CreateObject("Scripting.FileSystemObject")
If (oFso.FileExists(filePath)) Then FileExists = true
Set oFso = Nothing
End Function
Function BuildPath(ByVal path, ByVal subPath)
Dim oFso
Set oFso = CreateObject("Scripting.FileSystemObject")
BuildPath = oFso.BuildPath(path, subPath)
Set oFso = Nothing
End Function
Function GetSpecialFolderPath(ByVal specialFolderName, ByRef folderPath)
On Error Resume Next
Dim WshShell
GetSpecialFolderPath = false
Set WshShell = CreateObject("WScript.Shell")
folderPath = WshShell.SpecialFolders(specialFolderName)
If (Err = 0) Then GetSpecialFolderPath = true
Set WshShell = Nothing
End Function
Function CopyFile(ByVal source, ByVal dest, ByVal force)
On Error Resume Next
Dim oFso, fileCopied
fileCopied = false
Set oFso = CreateObject("Scripting.FileSystemObject")
oFso.CopyFile source, dest, force
If (Err = 0) Then fileCopied = true
Err.Clear
CopyFile = fileCopied
Set oFso = Nothing
End Function
Function CreateDirectoryPath(ByVal folderPath)
On Error Resume Next
Dim oFso, rc, parentFolderExists
CreateDirectoryPath = false
Set oFso = CreateObject("Scripting.FileSystemObject")
If oFso.FolderExists(folderPath) Then
CreateDirectoryPath = true
Exit Function
End If
parentFolderExists = CreateDirectoryPath(oFso.GetParentFolderName(folderPath))
If (Not parentFolderExists) Then Exit Function
Err.Clear
oFso.CreateFolder(folderPath)
If (Err = 0) Then CreateDirectoryPath = true
Err.Clear
Set oFso = Nothing
End Function
Posted by:
harshakola
14 years ago
Hi Angel
The script what u have sent to me earlier was working and i'm done with my work..Thanks once agian for posting me new script..
Thank u...
The script what u have sent to me earlier was working and i'm done with my work..Thanks once agian for posting me new script..
Thank u...
Rating comments in this legacy AppDeploy message board thread won't reorder them,so that the conversation will remain readable.