vbs skript pro zazipování 2 složek? Vyřešeno

[d1amond]

Zdravím,
věděl by někdo poradit, jak ve vbs nechat do zip zkomprimovat 2 složky?

Díky

//W7 64bit

[Reklama]

[ITCrowd]

Věděl

[d1amond]

No to jsem rád

[ITCrowd]

Můžeš víc napsat? Jako budou názvy s mezerami, složky budou na stejném/různém disku, co má obsahovat název výsledného souboru atd...

[d1amond]

Dvě složky z C a D, např. C:\Temp1 a D:\Temp2. Komprese by byla do dvou samostatných zip. Zip bude na D:.

[ITCrowd]

Kód: Vybrat vše

'****************************************************
'*        Skript zazipuje dva adresáře              *   
'****************************************************
'*           Vytvořeno pro PC-HELP                  *
'*            Etienn@Script v 1.0                   *
'****************************************************



Option Explicit
Dim fso, winShell, adr1, adr2, CilFile, file

Set fso = CreateObject("Scripting.FileSystemObject")
Set winShell = createObject("shell.application")
adr1 = "C:\temp1"
adr2 = "D:\temp2"
CilFile = "D:\archivecek.zip"

Set file = fso.CreateTextFile(CilFile, True)
file.write("PK" & chr(5) & chr(6) & string(18,chr(0)))
file.close

winShell.NameSpace(CilFile).CopyHere winShell.NameSpace(adr1).Items
do until winShell.namespace(CilFile).items.count = winShell.namespace(adr1).items.count
    wscript.sleep 1000
Loop

winShell.NameSpace(CilFile).CopyHere winShell.NameSpace(adr2).Items
do until winShell.namespace(CilFile).items.count = winShell.namespace(adr2).items.count
    wscript.sleep 1000
Loop

Set winShell = Nothing
Set fso = Nothing

[Žbeky]

ITCrowd: VBS přímo neumím, z toho, co o programování vím, to ale vypadá, že to obě složky zazipuje do jednoho archivu, ne? A d1amond chce každé zvlášť. Jestli to je správně, tak se omlouvám

[ITCrowd]

Správně. Dík za upozornění. Upravím to.

Kód: Vybrat vše

'****************************************************
'*        Skript zazipuje dva adresáře              *   
'****************************************************
'*           Vytvořeno pro PC-HELP                  *
'*            Etienn@Script v 1.0                   *
'****************************************************



Option Explicit
Dim fso, winShell, adr1, adr2, CilFile1, CilFile2, file

Set fso = CreateObject("Scripting.FileSystemObject")
Set winShell = createObject("shell.application")
adr1 = "C:\temp1"
adr2 = "D:\temp2"
CilFile1 = "D:\archivecek.zip"
CilFile2 = "D:\archivek.zip"

Set file = fso.CreateTextFile(CilFile1, True)
file.write("PK" & chr(5) & chr(6) & string(18,chr(0)))
file.close
winShell.NameSpace(CilFile1).CopyHere winShell.NameSpace(adr1).Items
do until winShell.namespace(CilFile1).items.count = winShell.namespace(adr1).items.count
    wscript.sleep 1000
Loop

Set file = fso.CreateTextFile(CilFile2, True)
file.write("PK" & chr(5) & chr(6) & string(18,chr(0)))
file.close
winShell.NameSpace(CilFile2).CopyHere winShell.NameSpace(adr2).Items
do until winShell.namespace(CilFile2).items.count = winShell.namespace(adr2).items.count
    wscript.sleep 1000
Loop

Set winShell = Nothing
Set fso = Nothing

[d1amond]

Funguje to perfektně. Mohl bych ještě poprosit o drobnou úpravu jako MsgBox, že vše proběhlo a následně vypnutí PC?

A to už si asi vymýšlím, ale šlo by ty zipy dohromady umístit do složky jejíž název je yymmdd? Mám totiž jeden vbs, který mi prochází složky podle data a starší maže (parametr dle počtu dní)

Jinak 10e6 děkuji

[ITCrowd]

1. Datum si skript má získat ze systémového data?
2. Vypnutí má být metodou force? (jinak to čeká na ukončení otevřených programů)
3. V MsgBox může být hláška + výběr zda vypnout či ne - chceš to tak?
4. V případě , že počítač půjde natvrdo vypnout, má být zobrazení zprávy časově omezeno (např. 30s a pak se odporoučí i bez kliknutí na OK)

[d1amond]

Čekat na ukončení programů.
Datum systémové.
Hláška stačí o úspěšném provedení zipu, vypnutí s odpočtem.

[ITCrowd]

Teď to čtu - s odpočtem - jedině že by se zkusilo 30x zobrazit okno. Jinak takhle to čeká 30s, pak to vypíná PC i bez reakce na tlačítko OK. MsgBox by čekal na zmáčknutí. Zálohu to kontroluje na přítomnost souborů.

Kód: Vybrat vše

'****************************************************
'*        Skript zazipuje dva adresáře              *   
'****************************************************
'*           Vytvořeno pro PC-HELP                  *
'*            Etienn@Script v 1.0                   *
'****************************************************



Option Explicit
Dim fso, winShell, adr1, adr2, CilFile1, CilFile2, file
Dim Den, Mesic, Rok, cesta, Action, strComputer
Dim objWMIService, colOS, objOS

Set fso = CreateObject("Scripting.FileSystemObject")
Set winShell = createObject("shell.application")
adr1 = "C:\Temp1"
adr2 = "D:\Temp2"
CilFile1 = "D:\archivecek.zip"
CilFile2 = "D:\archivek.zip"

' vytvoreni nazvu adresare
Den = Day(Now())
Mesic = Month(Now())
Rok = Year(Now())
Rok = Right(Rok, 2)
If Den < 10 Then Den = "0" & Den
If Mesic < 10 Then Mesic = "0" & Mesic
cesta = "D:\" & Rok & Mesic & Den & "\"
CilFile1 = cesta & "archivecek.zip"
CilFile2 = cesta & "archivek.zip"

If (Not fso.FolderExists(cesta)) Then fso.CreateFolder(cesta)

Set file = fso.CreateTextFile(CilFile1, True)
file.write("PK" & chr(5) & chr(6) & string(18,chr(0)))
file.close
winShell.NameSpace(CilFile1).CopyHere winShell.NameSpace(adr1).Items
do until winShell.namespace(CilFile1).items.count = winShell.namespace(adr1).items.count
    wscript.sleep 1000
Loop

Set file = fso.CreateTextFile(CilFile2, True)
file.write("PK" & chr(5) & chr(6) & string(18,chr(0)))
file.close
winShell.NameSpace(CilFile2).CopyHere winShell.NameSpace(adr2).Items
do until winShell.namespace(CilFile2).items.count = winShell.namespace(adr2).items.count
    wscript.sleep 1000
Loop

If Not fso.FileExists(CilFile1) Then
 MsgBox "Záloha se nepodařila", _         
           vbOKOnly + vbCritical, "Upozornění"
 Else
    If Not fso.FileExists(CilFile2) Then
       MsgBox "Záloha se nepodařila", _         
           vbOKOnly + vbCritical, "Upozornění"
    Else

Zobraz 30, "Záloha proběhla v pořádku", 64, "Výsledek:"

' Vypni PC
' Action = 1 => shutdown
' Action = 2 => restart
' Action = 0 => logoff
' Action = 8 => poweroff
' Force = Action + 4
Action = 1
strComputer = "." ' Local Computer
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate,(Shutdown)}!\\" & _
         strComputer & "\root\cimv2")
Set colOS = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
For Each objOS in colOS
'   objOS.Win32Shutdown(Action)
Next


  End If
End If

Set winShell = Nothing
Set fso = Nothing

'———————————————————————————————————————————————————————————————
' Funkce zobraz na určitý počet sekund
'———————————————————————————————————————————————————————————————
'Příklad zadání: (sekundy, "Zpráva", ikona, "Titulek"
' Zobraz 5, "Toto okno se zavře samo", 64, "Zpráva OK"
 Sub Zobraz(Seconds, Message, Ikona, Titulek)
 Dim objFuncShell
 If IsEmpty(objFuncShell) Then Set objFuncShell = CreateObject("wscript.shell")
 objFuncShell.Popup Message, Seconds, Titulek, Ikona + 4096
 Set objFuncShell = Nothing
 End Sub