title: VBA Access: How to zip and encrypt a directory from VBA Access?
body: <p>Do how does one go about Zipping a directory and and encrypting the zip file using VBA Access using the windows standard zip function?</p>
  
  <p>So far i have managed to find code which Creates a Zip file and moves the files from the directory to the zip file. However the Zip file is not encrypted. See Code below:</p>
  
  <pre><code>Public Function AddFilesToZip()
  
  Dim objFSO As Object, objZip As Object, objShell As Object
  Dim objFolder As Object, objFile As Object
  Dim sngStart As Single
  Dim strPath As String, strZip As String
  Dim inputfile As DAO.Recordset
  Set inputfile = CurrentDb.OpenRecordset("SELECT InputFilepath, Format(End_of_Month, 'yyyymmdd')  FROM CONFIG WHERE Active = True;")
  strPath = inputfile(0)  'Path to read files from
  
  
  strZip = strPath &amp; "Test Import Files " &amp; inputfile(1) &amp; ".zip"  'Output zip file
  
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  Set objZip = objFSO.CreateTextFile(strZip)
  objZip.WriteLine Chr(80) &amp; Chr(75) &amp; Chr(5) &amp; Chr(6) &amp; String(18, 0)
  objZip.Close
  
  Set objShell = CreateObject("Shell.Application")
  Set objFolder = objFSO.GetFolder(strPath)
  
      'loop through files - adding them to the zip
  For Each objFile In objFolder.Files
      If objFile &lt;&gt; strZip Then
      'objShell.NameSpace("" &amp; strZip).CopyHere objFile.Path
      objShell.NameSpace("" &amp; strZip).MoveHere objFile.Path
      sngStart = Timer
      Do While Timer &lt; sngStart + 2
          DoEvents
      Loop
      End If
  Next
  
  
  
  End Function
  </code></pre>