Přidat otázku mezi oblíbenéZasílat nové odpovědi e-mailem Vytvoření zástupců do adresářových složek

Pokud umíš vbs skript, lehká inspirace (třeba se ti vyplatí si to naprogramovat).

Rem Skript pro generaci novych Alb zastupcu.
Rem Postupne se projdou vsechny podadresare ve zdrojovem adresari.
Rem Pro kazdy podadresar se zalozi stejnojmenny podadresar v cilovem adresari.
Rem Pro kazdeho zastupce ve zdrojovem podadresari se v cilovem podadresari !!! pro každý soubor ve zdrojovem podadresari - nutné upravit !!!
Rem zalozi novy zastupce, ve kterem je zmeneno pismeno disku v odkaze.

Option Explicit

Dim goArgs, goShell, goFileSys, goFhLog
Dim goFldrZ, goFldrC
Dim gAdrParZ, gAdrParC, gPismeno
Const LogName = "AlbaZastupcuNova.log"

Set goArgs = WScript.Arguments
Set goShell = WScript.CreateObject("WScript.shell")
Set goFileSys = WScript.CreateObject("Scripting.FileSystemObject")

ZalozLog LogName

If Not ProchazeniAlb() Then
goFhLog.Writeline "Chyba - vypis nedokoncen"
End If

ZavriLog

Set goArgs = Nothing
Set goShell = Nothing
Set goFileSys = Nothing

Function ProchazeniAlb()

ProchazeniAlb = False

If goArgs.Count = 3 Then
gPismeno = goArgs.Item(0)
gAdrParZ = goArgs.Item(1)
gAdrParC = goArgs.Item(2)
Else
goFhLog.Writeline "Chyba - nejsou zadany adresare a pismeno"
Exit Function
End If

If Not goFileSys.FolderExists(gAdrParZ) Then
goFhLog.Writeline "Chyba - zdrojovy adresar neexistuje " & gAdrParZ
Exit Function
End If
If Not goFileSys.FolderExists(gAdrParC) Then
goFhLog.Writeline "Chyba - cilovy adresar neexistuje " & gAdrParC
Exit Function
End If
If Not ((gPismeno >= "A") And (gPismeno <= "Z")) Then
goFhLog.Writeline "Chyba - pismeno neni spravne " & gPismeno
Exit Function
End If

Set goFldrZ = goFileSys.GetFolder(gAdrParZ)
Set goFldrC = goFileSys.GetFolder(gAdrParC)

If Not Podadresare() Then
goFhLog.Writeline "Chyba - zpracovani podadresaru nedokonceno"
Exit Function
End If

ProchazeniAlb = True
End Function

Function Podadresare()

Dim oFset, oSubf
Dim SubfC

Podadresare = False
Set oFset = goFldrZ.SubFolders

For Each oSubf in oFset

SubfC = gAdrParC & "\" & oSubf.Name
goFileSys.CreateFolder(SubfC)
goFhLog.Writeline "A=" & SubfC

If Not Zastupci(oSubf, SubfC) Then
goFhLog.Writeline "Chyba - zpracovani zastupcu nedokonceno"
Exit Function
End If

Next

Podadresare = True
End Function

Function Zastupci(Byval PodadrZ, PodadrC)

Dim oFold, oFset, oFile
Dim oShellLink
Dim ZastupceZ, ZastupceC, Delka, NovyOdkaz

Zastupci = False
Set oFold = goFileSys.GetFolder(PodadrZ)
Set oFset = oFold.Files

For Each oFile In oFset
ZastupceZ = PodadrZ & "\" & oFile.Name
Set oShellLink = goShell.CreateShortcut(ZastupceZ)
NovyOdkaz = oShellLink.TargetPath
Delka = Len(NovyOdkaz)
NovyOdkaz = Right(oShellLink.TargetPath, Delka - 3)
NovyOdkaz = gPismeno & ":\" & NovyOdkaz
ZastupceC = PodadrC & "\" & oFile.Name
Set oShellLink = goShell.CreateShortcut(ZastupceC)
oShellLink.WindowStyle = 1
oShellLink.Description = ""
oShellLink.TargetPath = NovyOdkaz
oShellLink.Save
goFhLog.Writeline "Z=" & ZastupceC
Next

Zastupci = True
End Function

Sub ZalozLog(LogFile)

Set goFhLog = goFileSys.CreateTextFile(Logfile)
goFhLog.Close
Set goFhLog = goFileSys.OpenTextFile(Logfile, 2)

End Sub

Sub ZavriLog

goFhLog.Close

End Sub

Reakce na odpověď

1 Zadajte svou přezdívku:
2 Napište svou odpověď:
3 Pokud chcete dostat ban, zadejte libovolný text:

Zpět do poradny