Move files to ZIP while keeping its structure

[Fla$her]

maybe a "wait until current file is done" could cause a better (and slower) execution?

OK. Check the new version with the group mask in the parameters:

Code: Select all

'————————————————————————————————————————————————————————————————
' Zip packaging of each file in the folder structure by file mask
' Condition:  empty start path
' Parameters: <file mask>
' Example:    name.ext;*.exe;*.txt
'————————————————————————————————————————————————————————————————
Option Explicit: Dim FSO, Shell, ZIP
If WSH.Arguments.Count = 0 Then MsgBox "Specify the mask as a parameter!", 4144: WSH.Quit
Set FSO   = CreateObject("Scripting.FileSystemObject")
Set Shell = CreateObject("Shell.Application")
ZIP = "PK" & Chr(5) & Chr(6) & String(18, Chr(0))
Recursion FSO.GetAbsolutePathName("")
Set Shell = Nothing: Set FSO = Nothing
MsgBox "       Done!", 262208, " Zip packaging by extension       "

Sub Recursion(Dir)
   Dim Items, File, Arch, Size, Sleep, Folder
   Set Items = Shell.NameSpace(Dir).Items
   Items.Filter 73920, WSH.Arguments(0)
   If Items.Count Then
      For Each File In Items
         Arch = Dir & "\" & File.Name & ".zip"
         With FSO.CreateTextFile(Arch, 1) .Write ZIP: .Close: End With
         Size = File.Size: If Size < 786433 Then Sleep = 10 Else _
         If Size < 3145728 Then Sleep = Fix(Size/78644) Else Sleep = 400
         With Shell.NameSpace(Arch)
            .CopyHere File, 13332
            While .Items.Count = 0: WSH.Sleep Sleep: Wend
         End With
         FSO.DeleteFile File.Path, 1
      Next
   End If
   For Each Folder In FSO.GetFolder(Dir).SubFolders
      Recursion Folder.Path
   Next
End Sub

[Peter]

Thanks, but something is wrong

I tried with 263 files, XML, in one folder, on local disk, size from 0 - 53 MB.

It runs for 2 or 8 files, then it stops with errors from

- Windows Script Host: Error - File not found. Source - Runtime Error in VBS; Line 29, Pos. 44 (That's the delete command)
- Zip compressed folder: files were added to the archive. Originals could not be removed completely

I think I will continue with AHK which I know better are were are good "Wait" and "Exist" functions ..

[Fla$her]

It would be interesting to see such a structure. I can't catch the error myself.
It's not about the language, but about asynchronous CopyHere/MoveHere methods that return nothing. AHK has no fundamental advantages here.

Error - File not found. ... Originals could not be removed completely

These things don't fit in with logic. If there is no file, then what should be delete?
Try between 20 and 21 lines to insert:

Code: Select all

      On Error Resume Next

P. S.: With the utility (7z, rar, pkzip), this would be solved easily, because it would be enough to wait for the process.

[Peter]

It would be interesting to see such a structure. ...

I just searched my network for (usually) big text files and copied them multiple times to local PC.

...These things don't fit in with logic. If there is no file, then what should be delete?...

As I don't understand the code in detail I can not help, but I see a "FileMove" and then a "FileDelete". Maybe there is the problem?

...Try between 20 and 21 lines to insert...

I did, and it finished all jobs as described above, but nine source-files (from 0.1 - 2 MB) threw the same messages..

[Fla$her]

As I don't understand the code in detail I can not help, but I see a "FileMove" and then a "FileDelete". Maybe there is the problem?

No, because there is a check for existence before deletion. This was done specifically for large files, with which "MoveHere" doesn't provide deletion.

I did, and it finished all jobs as described above, but nine source-files (from 0.1 - 2 MB) threw the same messages..

Please provide a screenshot. It is unclear where the message about the absence of the file comes from.
In line 26 of the source code, replace Move with Copy. After that, logically there should be no problem.

[Peter]

Please provide a screenshot. It is unclear where the message about the absence of the file comes from....

Here it is:
https://1drv.ms/u/s!As0XWvf-DK0DgmmWUkebBEMRCERS?e=iMaGeS

Thanks

[Fla$her]

2Peter
Curious. I have not encountered such errors yet. Have you tried running with elevated rights (*)?
What is the result after the proposed edit?

[Peter]

Curious. I have not met with such a person. ...

???

...Have you tried running with elevated rights (*)?...

No, I'm local admin on my PC.

...What is the result after the proposed edit?

After modification from Move to Copy it works fine without errors. About 70 sec for the examples described above.

So thanks to all for their contribution; it's OK for me now.

[Fla$her]

???

Sorry. Fixed.

No, I'm local admin on my PC.

It was worth trying with *wscript.exe before the path to the script. The administrator account on modern versions of Windows doesn't have elevated rights.

it works fine without errors.

Good. Corrected the code. Also made a choice of delay a little smarter.