home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2003 August / PCWELT_8_2003.ISO / pcwsoft / Linker.z.exe / Linker.VBS
Encoding:
Text File  |  2003-05-13  |  2.0 KB  |  64 lines
  1. dim counter
  2. SET MyShell = Wscript.CreateObject("Wscript.Shell")
  3. SET MyFiles = CreateObject("Scripting.FileSystemObject")
  4. Set AppShell = CreateObject("Shell.Application")
  5. on error resume next
  6.  
  7. Set AppFolder = Appshell.BrowseForFolder(0, "WΣhlen Sie den Ordner, den Sie komplett verlinken wollen...",  &H0001, 17)
  8. quelle = AppFolder.ParentFolder.ParseName(AppFolder.Title).Path
  9. If err.number > 0 then 
  10.     i=instr(AppFolder, ":")
  11.     quelle = mid(AppFolder, i - 1, 1) & ":\"
  12. end if
  13. if quelle = "" then wscript.quit
  14. if right(quelle,1)<>"\" then quelle=quelle & "\"
  15.  
  16. Set AppFolder = Appshell.BrowseForFolder(0, "WΣhlen Sie den Zielordner fⁿr die Links...",  &H0001, 17)
  17. ziel = AppFolder.ParentFolder.ParseName(AppFolder.Title).Path
  18. If err.number > 0 then 
  19.     i=instr(AppFolder, ":")
  20.     ziel = mid(AppFolder, i - 1, 1) & ":\"
  21. end if
  22. if ziel="" then wscript.quit
  23. if right(ziel,1)<>"\" then ziel=ziel & "\"
  24.  
  25. yesno=msgbox ("Alle Dateien und Ordner von " & quelle & " nach " & ziel & " verlinken?",4,"")
  26. if yesno=7 then wscript.quit
  27.  
  28. set drive = MyFiles.GetFolder(quelle)
  29. set dat=drive.Files
  30. for each datei in dat
  31.     quicklink=ziel & "\" & datei.name & ".LNK"
  32.     set AktuelleDatei=MyFiles.Getfile(datei)
  33.     set link = MyShell.CreateShortcut(QuickLink)
  34.     link.TargetPath=AktuelleDatei.path
  35.     link.save
  36. next 
  37.  
  38. on error goto 0
  39.  
  40. SubFolders drive
  41. msgbox "Fertig." & chr(13) & counter & " Link(s) angelegt."
  42.  
  43. Sub SubFolders(ByVal AFolder)
  44.    Set MoreFolders = AFolder.SubFolders
  45.    For Each AktuellerOrdner In MoreFolders
  46.         newfolder=replace(AktuellerOrdner,Quelle,Ziel)
  47.         myfiles.createFolder(newfolder)
  48.       set dat=AktuellerOrdner.Files
  49.         for each datei in dat
  50.             if ucase(right(datei,3)) = "PIF" OR ucase(right(datei,3)) = "LNK" then
  51.             else
  52.                 set AktuelleDatei=MyFiles.Getfile(datei)
  53.                 quicklink=newfolder & "\" & datei.name & ".LNK"
  54.                 set link = MyShell.CreateShortcut(QuickLink)
  55.                 link.TargetPath=AktuelleDatei.path
  56.                 link.save
  57.                 counter=counter + 1
  58.             end if
  59.         next 
  60.          SubFolders AktuellerOrdner
  61.    Next 
  62. End Sub
  63.  
  64.