PC-HELP.CZ

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

Díky

//W7 64bit

Věděl

No to jsem rád

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...

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:.

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

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 :oops:

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

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

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)

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

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

PC-HELP.CZ

vbs skript pro zazipování 2 složek?

vbs skript pro zazipování 2 složek?

Re: vbs skript pro zazipování 2 složek?

Re: vbs skript pro zazipování 2 složek?

Re: vbs skript pro zazipování 2 složek?

Re: vbs skript pro zazipování 2 složek?

Re: vbs skript pro zazipování 2 složek?

Re: vbs skript pro zazipování 2 složek?

Re: vbs skript pro zazipování 2 složek?

Re: vbs skript pro zazipování 2 složek?

Re: vbs skript pro zazipování 2 složek?

Re: vbs skript pro zazipování 2 složek?

Re: vbs skript pro zazipování 2 složek?