Create password protected spreadsheet with access

[Rick A.B.]

I use the following to export the results of a query to an excel
spreadsheet.

Private Sub btnXlsExport_Click()
Dim SheetName As String

SheetName = Me.FAATermID.Column(1) + "PData"

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9,
"qryFAAFG", "H:" & SheetName + ".xls"
MsgBox "The report has been exported to excel in your H: Drive and
named " & SheetName + ".xls"

End If

Because of the sensitive information contained in the data, I would
like to create the spreadsheet with a password. Is there a another
way of coding this from Access to automatically create the protected
spreadsheet?

Rick

 

[Rick A.B.]

Sorry the End if should be End Sub.

 

[Keven Denen]

I use the following to export the results of a query to an excel
spreadsheet.

Private Sub btnXlsExport_Click()
Dim SheetName As String

SheetName = Me.FAATermID.Column(1) + "PData"

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9,
"qryFAAFG", "H:" & SheetName + ".xls"
MsgBox "The report has been exported to excel in your H: Drive and
named " & SheetName + ".xls"

End If

Because of the sensitive information contained in the data, I would
like to create the spreadsheet with a password.  Is there a another
way of coding this from Access to automatically create the protected
spreadsheet?

Rick

You'll want to do something along these lines. You may need to tweak
this a little bit, as I just merged your code into the standard code I
use for protecting things, so I haven't tested it.

Option Compare Database

Private Sub Command0_Click()
Dim sPath As String
Dim oExcelFile As Object
Dim SheetName As String

SheetName = Me.FAATermID.Column(1) + "PData"
sPath = "H:" & SheetName + ".xls"

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9,
"qryFAAFG", sPath

Set oExcelFile = CreateObject("excel.application")
oExcelFile.workbooks.Open (sPath)

Call ProtectDocument(oExcelFile, "password")
oExcelFile.activeworkbook.Save

If Not oExcelFile Is Nothing Then
oExcelFile.activeworkbook.Close
Set oExcelFile = Nothing
End If

End Sub

'================================================================
'FUNCTION: ProtectDocument
'DESC: Protects the specified document
'IN: oDocument The document object
' sPassword The password to use to protect the document
'OUT
'================================================================
Public Sub ProtectDocument(oDocument As Object, sPassword As String)
Dim sheetcount As Integer
Dim I As Integer

If oDocument.Name = "Microsoft Excel" Then
sheetcount = oDocument.Worksheets.Count
If sheetcount > 0 Then
oDocument.sheets(1).Select
For I = 1 To sheetcount
oDocument.activesheet.protect sPassword,
DrawingObjects:=True, Contents:=True, Scenarios:=True
If I < sheetcount Then
oDocument.activesheet.Next.Select
Else
oDocument.sheets(1).Select
End If
Next I
End If
Else
oDocument.activedocument.protect Type:=2, Password:=sPassword
End If
End Sub

Keven Denen