'#################################################

' The purpose of this VBS is for creating the shortcut set for the public folders
' The reason why create this VBS is: some same style information was saved in different subfolder, it is not easy to find out all similar information from a lot off subfolder
'
' This VBS is planed to perform at 2:10 each day.
'
'Functions description:
'1: Generate Shortcuts set for target subfolders
'2: Check all old exist Shortcuts if they are invalid, if yes, delete it
'3: Generate shortcuts according to the distination subfolders
' Created by Tom Yu / 2012-07-15
'#################################################
 
 
Dim LogAddress, ShutCutAdd, DGFolder, SCFolder
LogAddress = "d:\Suppliers\00_AUTOSET\AUTOSET.log"   ' ###Address of log, normally, it is not necessary to change
ShutCutAdd = "d:\Suppliers\00_AUTOSET\Audits\"       ' ###Folder of the shortcut set, the actual address will be add Year with bellow codes, it have to be set for different subfolders
DGFolder = "d:\Suppliers"                            ' ###Target folder address, it has to be set for different subfolders
SCFolder = "\20-Audits\"                             ' ###Target subfolder, it has to be set for target subfolders
aa=0
'On error resume Next
 
'------------------ Define the Shortcut function, Log function, and Shortcut checking function
 
Function FilesTree(Path1,Depth)  'Path1 is the folder which need to be checked,Depth is folder level.
 
    Dim wshShell, Shortcut, strDir, strName, SFolders
 
    'Traverse all folders with Depth folder level
    Set wshShell = WSH.CreateObject("WScript.Shell")
    Set oFso = CreateObject("Scripting.FileSystemObject")
    Set SFolderGet=CreateObject("Scripting.FileSystemObject")
    Set Fs=CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFso.GetFolder(Path1)
    Set SFoldersO = SFolderGet.GetFolder(ShutCutAdd)
 
 
   
For each SFoldersname In SFoldersO.SubFolders 'Check year folders circle to sure if need create the year folder
   SFolders=SFoldersname.Name
 
   if Depth > 0 then
    For Each oSubFolder In oFolder.SubFolders
        FilesTree oSubFolder.Path, Depth -1
    If (Fs.folderexists(oSubFolder.Path&SCFolder&SFolders)) then    'Check if the year folder is exist alreay
 
       If not (Fs.folderexists(ShutCutAdd&SFolders)) then set foldr=fs.createfolder(ShutCutAdd&SFolders)  'Check the target folder exist or not, Create it if not    
            
        'Generate the shortcut
strDir = ShutCutAdd&SFolders               ' Define the folder for store the shortcuts set
strName = oSubFolder.Name               ' Define the shortcuts name
 
    'Check if the shortcut exist and has Read Only attribute, if yes, remove the attribute
    If (Fs.fileexists(strDir & "\" & strName & ".lnk")) then 
    Set ShortCheck = Fs.getfile(strDir & "\" & strName & ".lnk")     
    If ShortCheck.Attributes <> 0 then ShortCheck.Attributes = 0
    end if
 
         Set Shortcut = wshShell.CreateShortcut(strDir & "\" & strName & ".lnk")   'Generate shortcut
         Shortcut.TargetPath = oSubFolder.Path&SCFolder&SFolders                      'setup the target folder address
         Shortcut.WindowStyle = 1                                                         
         'Shortcut.Hotkey = "CTRL+ALT+U"
         'Shortcut.Description = "This shortcut was created automatically by VBS"
         Shortcut.WorkingDirectory = oSubFolder.Path&SCFolder                      'Set Start In folder
         Shortcut.Save                                                             'Save the shortcut now
    
      End If  
    Next
   End if 
 Next
 
'Clear all define
 
    Set WriteLog = Nothing
    Set Shortcut = Nothing
    Set wshShell = Nothing
    Set oFolder = Nothing
    Set oFso = Nothing
    Set strDir = Nothing
    Set strName = Nothing
    Set SFolders = Nothing
    
End Function
 
 
'Write content to a txt file
Function WriteLogFile(strFileName, strContent)   ' strFileName mean the log address, et."D:\Suppliers\00AUTOSET\AUTOSET.log", strContent mean the content.
      'WiteNewFile = Flase             '''''''' default return value of function
      Set ObjLog = CreateObject("scripting.FileSystemObject")
      Const ForReading = 1, ForWriting = 2, ForAppending = 8
      Set objLogWrite =ObjLog.OpenTextFile(strFileName,ForAppending,True,TristateFalse)
      objLogWrite.WriteLine strContent
      objLogWrite.Close
      Set ObjLog = Nothing
      Set objLogWrite = Nothing
End Function
 
 
Function CheckLink(LinkFolder)  
    Set LinkWsh = WSH.CreateObject("WScript.Shell")
    Set LinkFs = CreateObject("Scripting.FileSystemObject")  
    Set LinkFoldr = LinkFs.GetFolder(LinkFolder)  
    Set Linksubfoldrs = LinkFoldr.SubFolders        
    Set LinkFiles = LinkFoldr.Files 
  
 
    For Each oFile In LinkFiles 
   aa=aa+1
       if Right(LCase(oFile.Path),4)=".lnk"  then 
       'WScript.Echo oFile.Path
       Set Chlnk = LinkWsh.CreateShortcut(oFile.Path)
       Lnkaddss = ChLnk.TargetPath
       'WScript.Echo ChLnk.TargetPath
       If not (LinkFs.folderExists(ChLnk.TargetPath)) then oFile.Delete
       End If
         
    Next  
 
 
   For Each oSubFolder In Linksubfoldrs  
        'WScript.Echo oSubFolder.Path  
       CheckLink(oSubFolder.Path)
   Next  
      
    Set LinkWsh = Nothing    
    Set LinkFs = Nothing
    Set LinkFoldr = Nothing  
    Set Linksubfoldrs = Nothing  
    Set LinkFiles = Nothing
 
End Function  
 
'----------------------Start run the functions 
 
 
CheckLink (ShutCutAdd)                   'Check the exist shortcut if it is available, or delete it.
FilesTree (DGFolder),1                   'Create shortcut set.
WScript.Echo aa
 
' Due to the WriteLogFile function will be invalid if meet any error, So have to use full code to log the error here.
If ERR.Number <> 0 Then 
      Set ObjErr = CreateObject("scripting.FileSystemObject")
      Const ForReading = 1, ForWriting = 2, ForAppending = 8
      Set objErrWrite =ObjErr.OpenTextFile(LogAddress,ForAppending,True,TristateFalse)    ' Save error log
      objErrWrite.WriteLine Date&" | "& Time &" | "& ERR.Number &" | "&  ERR.Description 
      objErrWrite.Close
      Set ObjErr = Nothing
      Set objErrWrite= Nothing
Else 
WriteLogFile LogAddress, Date&" | "&Time&" | Generate shortcuts set into "& ShutCutAdd &" for subfolders "&SCFolder&" from "&DGFolder&" | OK ;-)"               ' Save normal log
End If 
 
'Clear define
 
Set LogAddress = Nothing 
Set ShutCutAdd = Nothing 
Set DGFolder = Nothing 
Set SCFolder = Nothing 
 
On Error GoTo 0