Save as zip with a password

Hello Ang12345,

This version has worked well for me. Try it out and let me know what happens.

'Written: December 05, 2007
'Author: Leith Ross
'Summary: Uses WinZip to zip or unzip a file and save it to an archive.

 Private Declare Function ShellExecute _
  Lib "Shell32.dll" _
    Alias "ShellExecuteA" _
     (ByVal hWnd As Long, _
      ByVal lpOperation As String, _
      ByVal lpFile As String, _
      ByVal lpParameters As String, _
      ByVal lpDirectory As String, _
      ByVal nShowCmd As Long) As Long


Sub ZipFile(FileName As String, Optional ByVal Password As String)

  Dim BackSlash As Long
  Dim CmdLine As String
  Dim Ext As Long
  Dim FilePath As String
  Dim RetVal As Long
  Dim ZipName As String
    
   'If no path is specified use the current directory
    BackSlash = InStrRev(FileName, "\")
    If BackSlash = 0 Then
       FilePath = CurDir & "\"
    Else
       FilePath = ""
    End If
    
   'Check if file exists
    If Dir(FilePath & FileName) = "" Then
       MsgBox "File Not Found" & vbCrLf & "  " & FilePath & FileName
       Exit Sub
    End If
    
   'Name for the zip archive
    Ext = InStrRev(FileName, ".")
      If Ext = 0 Then
         ZipName = FileName & ".zip"
      Else
         ZipName = Left(FileName, Ext) & "zip"
      End If
    
   'Command line string - file names must include quotes
    If Password = "" Then
       CmdLine = "-min -a -en " & Chr$(34) & ZipName & Chr$(34) & " " _
               & Chr$(34) & FileName & Chr$(34)
    Else
       CmdLine = "-min -a -en -s" & Chr$(34) & Password & Chr$(34) _
               & " " & Chr$(34) & ZipName & Chr$(34) & " " _
               & Chr$(34) & FileName & Chr$(34)
    End If
            
    'Command line String to Unzip a file
     'CmdLine = "-min -e " & Chr$(34) & ZipFileName & Chr$(34) & " " _
     '       & FolderPath
        
     'Zip the file and save it in the archive
      RetVal = ShellExecute(0&, "", "WinZip32.exe", CmdLine, FilePath, 1&)
  
   'Check for Errors are from 0 to 32
    If RetVal <= 32 Then
       Select Case RetVal
         Case 2     'SE_ERR_FNF
           Msg = "File not found"
         Case 3      'SE_ERR_PNF
           Msg = "Path not found"
         Case 5      'SE_ERR_ACCESSDENIED
           Msg = "Access denied"
         Case 8      'SE_ERR_OOM
           Msg = "Out of memory"
         Case 32     'SE_ERR_DLLNOTFOUND
           Msg = "DLL not found"
         Case 26     'SE_ERR_SHARE
           Msg = "A sharing violation occurred"
         Case 27     'SE_ERR_ASSOCINCOMPLETE
           Msg = "Incomplete or invalid file association"
         Case 28     'SE_ERR_DDETIMEOUT
           Msg = "DDE Time out"
         Case 29     'SE_ERR_DDEFAIL
           Msg = "DDE transaction failed"
         Case 30     'SE_ERR_DDEBUSY
           Msg = "DDE busy"
         Case 31     'SE_ERR_NOASSOC
           Msg = "Default Email not configured"
         Case 11     'ERROR_BAD_FORMAT
           Msg = "Invalid EXE file or error in EXE image"
         Case Else
           Msg = "Unknown error"
       End Select
      Msg = "File Not Zipped - " & Msg & vbCrLf & "Error " & RetVal
      MsgBox Msg, vbExclamation + vbOKOnly
    End If
  
End Sub

Macro Example

Sub Test()

 'Create a zipped copy of the file and save it to the same directory (C:\Test File.zip)
  ZipFile FileName:="C:\Test File.txt", Password:="123"
  
End Sub