Sending password-protected Winzipped reports to recipients

[Jibbadiah]

Hi folks,

I recently had a requirement to send many reports via email with sensitive customer data. The only thing that IT would allow was a strong password-protected winzip file. I will include a little of the code here - the remainder you should be able to glean from other posts.

I read recently that there is software which claims to generate 1 billion password attempts per minute. The software will use dictionary words, etc in an attempt to crack the code. Simply... don't use the easy passwords like January, Monday, pet's names, etc.

Public Function GeneratePassword()
'******************************************************************
'* Generate an 8 character pseudo random password in the format
'* [A-Z][a-z][special char][0-9][special char][A-Z][a-z][0-9]
'* This gives 24,174,030,400 combinations to guess at.
'******************************************************************
Dim i As Integer
Dim iSlot As Integer
Dim sSigns As String
Dim sPwd As String

sPwd = ""
sSigns = "<>\/!$%^&*()+{}[]@~#:;?"

Randomize
sPwd = Chr(Int((90 - 65) * Rnd + 65)) 'A-Z
Randomize
sPwd = sPwd & Chr(Int((122 - 97) * Rnd + 97)) 'a-z
Randomize
sPwd = sPwd & Mid(sSigns, Int((22 * Rnd) + 1), 1) 'select a sign from string sSigns
Randomize
sPwd = sPwd & Chr(Int((57 - 48) * Rnd + 48)) '0-9
Randomize
sPwd = sPwd & Mid(sSigns, Int((22 * Rnd) + 1), 1) 'select a sign from string sSigns
Randomize
sPwd = sPwd & Chr(Int((90 - 65) * Rnd + 65)) 'A-Z
Randomize
sPwd = sPwd & Chr(Int((122 - 97) * Rnd + 97)) 'a-z
Randomize
sPwd = sPwd & Chr(Int((57 - 48) * Rnd + 48)) '0-9

GeneratePassword = sPwd

End Function

I have found very few websites that tell you, but Winzip does have undocumented command-line switches so that you can create winzipped password-protected documents without the need for their add-in. In fact you can even do it with the evaluation versions. The best website that I have found for this is http://www.rondebruin.nl/windowsxpzip.htm

I don't want to bog down this post with common code, so I have just included the bits that you can add to existing email code.

'Some of the variables required...
Dim rstEmailDets As Recordset
Dim qryTempQueryForEmailReport As QueryDef
Dim qdfTemp As QueryDef
Dim strRecipient As String
Dim strEmail As String
Dim strReportName As String
Dim strWinzip As String
Dim strZipFile As String
Dim strWinzipCmd As String

' Create a recordset to include recipient and email address and loop through this recordset

'Create password - Note: be sure to store this somewhere or you won't be able to open your zip file!!
strPassword = GeneratePassword

'Save your file somewhere
strReportName = "C:\temp\ReportName.rtf"
            
'Create a query to use as basis for a report
Set qdfTemp = .CreateQueryDef("qryTempQueryForEmailReport", "SELECT * FROM qryDetailsForEmailReports WHERE Recipient = '" & strRecipient & "';")
                        
'Output a Report that is based on Above Query
DoCmd.OutputTo acOutputReport, "rptReportForEmail", acFormatRTF, strReportName
        
'Input the directory for your Winzip program, this is normally...
strWinzip = "C:\Program Files\WinZip\WinZip32.exe"
        
'Name winzip file same as file to be zipped
strZipFile = Left(strReportName, InStr(1, strReportName, ".", vbTextCompare) - 1) & ".zip"
                
'This is the line that zips and password protects the report
strWinzipCmd = strWinzip & " -a -ex -s" & strPassword & " """ & strZipFile & """ """ & strReportName & """"

'Shell the zipping process and wait until finished - there are many posts on this
RunDOSExecutable strWinzipCmd
            
'Create a new instance of an Outlook Application object and attach the file
.To = strEmail
.Body = vbCrLf & _
    "Dear " & strRecipient & "," & vbCrLf & vbCrLf & _
    "Please find attached a Password-Protected Winzip file that contains your report" & vbCrLf & vbCrLf & _
    "Please view intranet site page - www.intranet.com for the password to this report" & vbCrLf & vbCrLf & " "
.Importance = olImportanceNormal
.Attachments.Add (strZipFile)
.Send
            
'Clean up the objects used
.QueryDefs.Delete "qryTempQueryForEmailReport"
Kill strReportName

' A couple of errors that you may want to trap include...
' Err = -2147467259 Exceeded Storage Limit on Outlook Account
' Err = 2501 Attempted to cancel the output of the emails
' Both errors you could pop up an okonly message and then Resume

I hope that someone finds this useful.

If you find a way to create a self-extracting winzip file using the standard winzip functionality then please add the code to this post. I haven't been able to get it working, even with sendkeys

J.

 

[Jibbadiah]

Hallelujah!! - Finally created something that works. It's not pretty but it does the job.

The following creates a self-extracting file using the standard Winzip package by utilising the Sendkeys functionality.

Note: Please be sure that your users aren't keyboard happy if you intend to use this code!!

...
RunDOSExecutable strWinzipCmd
            
strSelfExtractingCmd = strSelfExtracting & " """ & strZipFile & """"

'This is the bit that creates the self-extracting Zip
ReturnValue = Shell(strSelfExtractingCmd, 1) ' Open Winzip Self-Extractor and enter name of zip file
AppActivate ReturnValue ' Activate the application
    For i = 1 To 4 ' Set up counting loop.
        Select Case i ' Create case depending upon position in loop
            Case 1
                SendKeys "{ENTER}", True 'Confirm Zip
            Case 2
                SendKeys "{ENTER}", True 'Confirm message about Password-Protection
            Case 3
                SendKeys "%{N}", True 'No - we don't want to test file
            Case Else
                SendKeys "%{C}", True 'Close Self-Extractor utility
        End Select
    Next i ' move to the next key.