Zip a file with a VBA program

Out of category
1

Hi all.

I have created a program which, since a drawing, has been exported in .PDF. DXF . STEP. . DWG

I would like that following this export the program zip the . DXF . STEP. . DWG

Below is an excerpt of the part of the program that creates the ZIP ( only the . STEP for the moment ) 

 '========================================================================
    ' ZIP files . STEP
    
    Information about the files (paths & names)
    FileAArchiver = DirDest & "\" & sFileRefWE & "-" & IndiceminNew & "-" & IndiceminRevue & IndiceminRevue & ". STEP"
    FileZip = DirDest & "\" & sFileRefWE & "-" & IndiceminNew & "-" & IndiceminRevue & ".ZIP"
    
    Create a new archive file
    If Len(Dir(ZipFile)) > 0 Then Kill ZipFile' deletes the archive if it already exists
    Open FileZip For Output As #1
        Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close #1
      
    'Moves the file to be archived to the archive
    Set ApplicationArchiving = CreateObject("Shell.Application")
    ApplicationArchive.Namespace(ZipFile). MoveHere FileAArchiver
    
    '========================================================================

The creation of the .zip has taken place but then on the line below it blocks

  ApplicationArchive.Namespace(ZipFile). MoveHere FileAArchiver

Should I check a case in "reference - EXPORT"? If so, which one?


01.jpg
02.jpg
2

Hello;

you are missing the reference "Microsoft Shell Controls And Automation". ?
But it's difficult to diagnose your problem without declaring your variables or without the error code....


Kind regards.

3

 

I did a test by enabling "Microsoft Shell Controls And Automation".

Unfortunately there is always a problem with the line:

ApplicationArchive.Namespace(ZipFile). MoveHere FileAArchiver

 

4

Declarations: 

    Dim ApplicationArchiving as Object
    Dim FileAArchiver As String
    Zip As String

On the ApplicationArchive.Namespace(ZipFile) row . MoveHere FileAArchiver

Runtime error '91': 

Object variable or With block variable not defined.

I ask if the orders . Namespace and . MoveHere are well recognized by Solidworks.

 

 

5

I tried this code (clever Excel) which works perfectly (including with MoveHere instead of CopyHere:

Sub ArchiverUnFichier()
'par Excel-Malin.com ( https://excel-malin.com )
'---------------------------------------------------------
'gestion des erreurs
    On Error GoTo ErreurCompression

'définition des variables
    Dim ApplicationArchivage As Object
    Dim FichierAArchiver, FichierZip
       
'informations sur les fichiers (chemins & noms)
    FichierAArchiver = "C:\Test\MonFichierWord.docx"
    FichierZip = "C:\Test\Archives\MonArchive_1.zip"
     
'créer un nouveau archive
    If Len(Dir(FichierZip)) > 0 Then Kill FichierZip 'supprime l'archive s'il existe déjà
    Open FichierZip For Output As #1
        Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close #1
      
'copier le fichier à archiver dans l'archive
    Set ApplicationArchivage = CreateObject("Shell.Application")
    ApplicationArchivage.Namespace(FichierZip).CopyHere FichierAArchiver

'Message final
    MsgBox "L'archivage a été lancé..."

Exit Sub
ErreurCompression:
    MsgBox "Une erreur s'est produite..."
End Sub

Wouldn't it be your variable ZipFile that has an inappropriate character for a path? Try with C:\Temp\Essai.zip for example.

1 Like
6

I did a test by placing the address directly in the AArchiver  File variable and in ZipFile.

It doesn't come from there. On the other hand, is having WINRAR on my PC problematic?

 sbadenis could you take a screenshot of your References - EXPORT?

mine below

 

 

 


capture.jpg
7

I just did a test on another pc that doesn't have WINRAR and it doesn't work either

8

The program works well on its own but not included in mine

9

Attached is the full program


data-pack_erp-dlb.swp
10

The problem comes from here:  M:\Common\PMI\DOC OFFICE\001234-K\\001234-K09-. STEP

The variable gives 2 \\ ........................ :/

1 Like
11

That's what I thought mistake in a path.

And for the record, no ref checked in +

1 Like
12

 

Last question. :)

The program only works if the extensions are displayed in Windows Explorer.

If not, how can weget around this problem?

 

13

Hello

Whether or not extensions are displayed should not influence the path of a file. It seems strange to me.

If for some obscure reason this is really the case, you have to see if it is possible to test the display state of the extensions from the script and if it is hidden, switch it to  visible for the time it is executed.

14

 

I found the origin of the problem. The VBA is too fast compared to Winzip. The files don't have time to finish being zipped before another one arrives.

So I placed a messagebox with yes/no so that the user gives the start for the next file.

I could also make a verification condition.

Otherwise solution make a single command line with several files but I don't know how to do it ( FileAArchiverSTEP = the file . WWTP )

I created another variable FileAArchiverDWG, FileAArchiverDXF for each file and each line sends it to the ZIP

ApplicationArchive.Namespace(ZipFile). MoveHere FileAArchiverSTEP

ApplicationArchive.Namespace(ZipFile). MoveHere FileAArchiverDWG

ApplicationArchive.Namespace(ZipFile). MoveHere FileAArchiverDXF

 

15

This should help you: https://stackoverflow.com/questions/40987787/vba-copyhere-copy-multiple-files-to-zip-file

16

Thank you for your link. In this example, it ZIPS the folder. If I change the beginning of my program to create a folder with the DXF, DXG and STEP, it can work:)

Sub testing()
Dim ZipFile As String
Dim FolderToAdd As String
Dim objShell As Object
Dim varZipFile As Variant

ZipFile = "C:\ZipFile_Images\images.zip"
FolderToAdd = "C:\Images"

Set objShell = CreateObject("Shell.Application")
varZipFile = ZipFile

If Right$(FolderToAdd, 1) <> "\" Then
    FolderToAdd = FolderToAdd & "\"
End If

objShell.NameSpace(varZipFile).CopyHere (FolderToAdd)
End Sub
2 Likes