Copying a single file into a zip archive

Question

it's my first time here.
I've looked into it for hours and can't find an answer.

I need to copy a single file from a folder into a zip archive (not all the files in the folder like everyone does).
The code works fine for copying all files in a folder but when I put a single filename instead it creates the zip file put does not put anything in it.

Private Sub Archive(sClientWB As String)
    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim sArchiveDir As String
    sArchiveDir = Application.ActiveWorkbook.Path + cClientFolder + "Archive\"
    'Create folder if does not exist
    If Not fso.FolderExists(sArchiveDir) Then fso.CreateFolder (sArchiveDir)

    Dim vFileNameZip
    vFileNameZip = sArchiveDir + fso.GetBaseName(sClientWB) + ".zip"

    'create the empty zipfile
    Open vFileNameZip For Output As #1
    Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close #1

    Dim objApp As Object
    Set objApp = CreateObject("Shell.Application")

    'add file to zip archive
    objApp.Namespace(vFileNameZip).CopyHere sClientWB
    'nothing happens, the file is not added to the zip

    'when I execute this instead :
    objApp.Namespace(vFileNameZip).CopyHere objApp.Namespace(ActiveWorkbook.Path + cClientFolder).items
    'works fine, all the files in the folder get copied in the zip file

End Sub

I have explicitly verify the sClientWB parameter and it is valid.
Folder strusture is
\Gestion Clients\Liste Clients.xlsm
\Gestion Clients\Clients\LapFre20180908.xlsm
\Gestion Clients\Clients\Archive\LapFre20180908.zip
Current workbook is \Gestion Clients\Liste Clients.xlsm

Thankyou for your help.

Answer 1

As Tim Williams mentioned in his comment, change sClientWB to be a Variant instead of a string.

You'll also want a brief pause after the .CopyHere statement to allow it time to actually process. Here's the code I use:

This gets the count of the number of files currently in the zip archive

Dim ShellApp As Object
Set ShellApp = CreateObject("Shell.Application")

Dim CurrentFileCount As Long
CurrentFileCount = ShellApp.NameSpace(Archive.ArchivePath & Archive.ArchiveName).Items.Count

This actually copies the file to the archive

ShellApp.NameSpace(Archive.ArchivePath & Archive.ArchiveName).CopyHere Archive.filePath & Archive.fileName

This loop waits until the file count has increased which tells me that it's done compressing.

Do Until ShellApp.NameSpace(Archive.ArchivePath & Archive.ArchiveName).Items.Count > CurrentFileCount

  Dim Pause As Date

  Pause = DateAdd("s", 1, Now())
  While Now < Pause
    DoEvents
  Wend
Loop

Note that I have created a class Archive that holds all the various and sundry bits necessary to create an archive file and populate it. Here are the referenced bits from above:

Const ARCHIVE_PATH As String = "Archive\"
Private pArchiveName As Variant                   'name of the zip file
Private pArchivePath As Variant                   'path to the zip file
Public Property Get ArchiveName() As Variant
  ArchiveName = pArchiveName
End Property
Public Property Let ArchiveName(ByVal Value As Variant)
  pArchiveName = Value
End Property
Public Property Get ArchivePath() As Variant
  ArchivePath = pArchivePath
End Property
Public Property Let ArchivePath(ByVal Value As Variant)
  pArchivePath = Value & ARCHIVE_PATH
End Property

The Const ARCHIVE_PATH is because I always put my archives in a directory below where the "raw" data lives. You can adjust this as necessary.