/build/static/layout/Breadcrumb_cap_w.png

Vb Script to check operating system and copy files using environmental folders

o.s check....

0 Comments   [ + ] Show comments

Answers (6)

Posted by: AngelD 11 years ago
Red Belt
0
Why complicate it?

Use the below instead:
Set WshShell = CreateObject("WScript.Shell")
DesktopFolder = WshShell.SpecialFolders("Desktop")
StartMenuProgramsFolder = WshShell.SpecialFolders("Programs")
Posted by: anonymous_9363 11 years ago
Red Belt
0
Come on! It isn't that hard? Think...!
Posted by: anonymous_9363 11 years ago
Red Belt
0
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 11 years ago
Senior Purple Belt
0
Hi Harsha,

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 11 years ago
Red Belt
0

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 11 years ago
Orange Belt
0
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...
Rating comments in this legacy AppDeploy message board thread won't reorder them,
so that the conversation will remain readable.

Don't be a Stranger!

Sign up today to participate, stay informed, earn points and establish a reputation for yourself!

Sign up! or login

View more:

Share

 
This website uses cookies. By continuing to use this site and/or clicking the "Accept" button you are providing consent Quest Software and its affiliates do NOT sell the Personal Data you provide to us either when you register on our websites or when you do business with us. For more information about our Privacy Policy and our data protection efforts, please visit GDPR-HQ