After so long I’m posting something, lately I was working on installation script of our project, and came across few good things. I’m sharing few of them here:
' *************************************
'Global variables
Dim objFSO, objLogFile, WsShell
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set WsShell = CreateObject("WScript.Shell")
'Getting Program Files path
Const PROGRAM_FILES = &H26&
Dim objShell, objFolder, objFolderItem, strProgramFilesPath
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(PROGRAM_FILES)
Set objFolderItem = objFolder.Self
strProgramFilesPath = objFolderItem.Path
WScript.Echo strProgramFilesPath
'For getting Documents and Settings\<UserName>
Dim strUserProfileFolder
strUserProfileFolder = WsShell.Environment("PROCESS")("UserProfile")
WScript.Echo strUserProfileFolder
'Getting Desktop folder
Dim objDesktop
objDesktop = WsShell.SpecialFolders("Desktop")
WScript.Echo objDesktop
'Rename File
Function RenameFile(oldName, newName)
If(objFSO.FileExists(oldName)) Then
objLogFile.WriteLine( oldName & "File found and renaming/moving it to " & newName)
DeleteFile newName
objFSO.MoveFile oldName, newName
objLogFile.WriteLine( oldName & "File renamed/moved successfully " & newName)
Else
objLogFile.WriteLine( oldName & " File does not exist.")
End If
End Function
'Rename Folder
Function RenameFolder(oldName, newName)
If(objFSO.FolderExists(oldName)) Then
If(objFSO.FolderExists(newName)) Then
objFSO.DeleteFolder newName, True
End If
objFSO.MoveFolder oldName, newName
End If
End Function
'Delete File
Function DeleteFile(filePath)
If objFSO.FileExists(filePath) Then
objFSO.DeleteFile filePath, True
objLogFile.WriteLine("File : " + filePath + " deleted successfully")
End If
End Function
'Calling an Excel Macro
Function CallExcelMacro(filePath, macroName)
Dim objExcel
Dim objWorkbook
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False
If objFSO.FileExists(filePath) Then
objExcel.EnableEvents = False
set objWorkbook = objExcel.Workbooks.Open (filePath)
objExcel.EnableEvents = True
objLogFile.WriteLine("Calling Macro :: " & macroName)
objExcel.Run "'" & objFSO.GetFileName(filePath) & "'!" & macroName
objWorkbook.Close True
Else
objLogFile.WriteLine( filePath & " File does not exist.")
End If
objExcel.Quit
Set objWorkbook = Nothing
Set objExcel = Nothing
End Function
'Registering .NET Components
Function RegisterComponents(assemblyPath, assemblyName)
Dim winDir
Dim param,program
Dim assemblyFullPath
assemblyFullPath = assemblyPath + "\"+ assemblyName
winDir = objFSO.GetSpecialFolder(0)
program = winDir + "\Microsoft.NET\Framework\v2.0.50727\RegAsm.exe "
If objFSO.FileExists(program) Then
objLogFile.WriteLine( "Registering... " + assemblyName)
' Register/UnRegiter Filename
param = " /unregister " + chr(34) + assemblyFullPath + chr(34)
WsShell.Run program + param , 0, True
param = " /tlb " + chr(34) + assemblyFullPath + chr(34) + " /codebase"
WsShell.Run program + param , 0, True
objLogFile.WriteLine( "Successfully Registered... " + assemblyName)
Else
objLogFile.WriteLine( "Failed to register assembly, as this machine does not have .NET Framework 2.0 runtime installed!")
End If
End Function
'Unregistering .NET Components
Function UnRegisterComponents(assemblyPath, assemblyName)
Dim winDir
Dim param,program
Dim assemblyFullPath
assemblyFullPath = assemblyPath + "\"+ assemblyName
winDir = objFSO.GetSpecialFolder(0)
program = winDir + "\Microsoft.NET\Framework\v2.0.50727\RegAsm.exe "
If objFSO.FileExists(program) Then
objLogFile.WriteLine( "UnRegistering... " + assemblyName)
' Register/UnRegiter Filename
param = " /unregister " + chr(34) + assemblyFullPath + chr(34)
WsShell.Run program + param , 0 , True
objLogFile.WriteLine( "Successfully UnRegistered... " + assemblyName)
Else
objLogFile.WriteLine( "Failed to unregister assembly, as this machine does not have .NET Framework 2.0 runtime installed!")
End If
End Function
'Copy Folder
Function CopyFolderToDestinationFolder(strSourcePath, strDestinationPath, strFolderToCopy)
Dim strTempSource
Dim strTempDestination
strTempSource = strSourcePath & strFolderToCopy
strTempDestination = strDestinationPath & strFolderToCopy
If Not (objFSO.FolderExists(strTempDestination))Then
CreateFolder(strTempDestination)
End If
If objFSO.FolderExists(strTempSource) Then
objLogFile.WriteLine( "Copy " & strFolderToCopy & " Folder : Start")
If objFSO.FolderExists(strTempDestination) Then
objFSO.DeleteFolder strTempDestination, True
End If
objFSO.CopyFolder strTempSource, strTempDestination
objLogFile.WriteLine( "Copy " & strFolderToCopy & " Folder : End")
Else
objLogFile.WriteLine( strTempSource & "Folder does not exist.")
End If
End Function
'Copy File
Function CopyFileToDestinationFolder(strSourcePath, strDestinationPath, strFileName)
If objFSO.FileExists(strSourcePath & strFileName) Then
objFSO.CopyFile strSourcePath & strFileName, strDestinationPath, True
objLogFile.WriteLine( "File : " & strSourcePath & strFileName & " copied successfully to " & strDestinationFolder & strFileName)
Else
objLogFile.WriteLine( strDestinationFolder & strFileName & " does not exist.")
End If
End Function
'Clearing Read only attribute of a file
Function ClearReadOnlyAttribute(filePath)
Dim file
If objFSO.FileExists(filePath) Then
Set file = objFSO.GetFile(filePath)
If file.Attributes Then
file.Attributes = 0
objLogFile.WriteLine("File : " + filePath + " attributes cleared successfully!")
End If
Else
objLogFile.WriteLine("File : " + filePath + " does not exists")
End If
End Function
'Create Desktop Shortcut
Function CreateDesktopShortcut(fullFilePath, shortcutName)
' ----------------------------------------------------------'
Dim objDesktop, objLink
Dim strIconPath
' --------------------------------------------------
' Here are the variables that to change if you are making a 'real' script
'strIconPath = "%SystemRoot%\system32\SHELL32.dll,5"
objDesktop = WsShell.SpecialFolders("Desktop")
Set objLink = WsShell.CreateShortcut(objDesktop & "\" & shortcutName & ".lnk")
' ---------------------------------------------------
' Section which adds the shortcut's key properties
objLink.Description = shortcutName
'objLink.HotKey = "CTRL+SHIFT+X"
'objLink.IconLocation = strIconPath
objLink.TargetPath = fullFilePath
objLink.WindowStyle = 3
'objLink.WorkingDirectory = filePath
objLink.Save
' End of creating a desktop shortcut
End Function
' **************************************
Happy Coding 