Tengo este código en Access que construye una tabla y la exporta al una carpeta en la PC, quisiera que al libro se le pudiera poner contraseña desde que se exporta para cuando sea abierto la solicite. No se como hacerlo

Private Sub cmdExportar_Click()
Dim rstNombrePrograma As DAO.Recordset, _
rstTituloTema As DAO.Recordset, _
qdf As DAO.QueryDef, _
strSQL As String, _
strHoja As String, _
strArchivo As String, _
strTitulo As String, _
Campo As DAO.Field, _
lngColumna As Long, _
i As Long, _
xls As Object
Const xlWBATWorksheet = -4167
Const xlAutomatic = -4105
Const xlSolid = 1
Const xlThemeColorDark1 = 1
Const xlToRight = -4161
Const xlNormal = -4143

On Error GoTo cmdExportar_Click_TratamientoErrores

strSQL = "SELECT NombrePrograma"
strSQL = strSQL & " FROM ProgramasEmitidos"
strSQL = strSQL & " GROUP BY NombrePrograma"

Set xls = CreateObject("Excel.Application")
xls.Visible = True

xls.Workbooks.Add xlWBATWorksheet
strHoja = xls.ActiveSheet.Name

Set rstNombrePrograma = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)

If Not (rstNombrePrograma.EOF And rstNombrePrograma.BOF) Then
Do
StrSQL = "SELECT TituloTema, NombreAutor, NombreInterprete, Sonatas, Fecha, Calculo, Local, Plantilla "
strSQL = strSQL & "FROM ProgramasEmitidos"
strSQL = strSQL & " WHERE NombrePrograma = Parametro1"
Set qdf = CurrentDb.CreateQueryDef("", strSQL)

qdf.Parameters("Parametro1") = rstNombrePrograma!NombrePrograma
Set rstTituloTema = qdf.OpenRecordset
xls.ActiveWorkBook.Sheets.Add Before:=xls.Worksheets(xls.Worksheets.Count)
xls.ActiveSheet.Name = rstNombrePrograma!NombrePrograma
With xls
lngColumna = 1
For Each Campo In rstTituloTema.Fields
strTitulo = ""
For i = 1 To Len(Campo.Name)
strTitulo = strTitulo & Mid(Campo.Name, i, 1)
If i < Len(Campo.Name) Then
If EsMayuscula(Mid(Campo.Name, i + 1, 1)) Then strTitulo = strTitulo & " "
End If
Next i
.ActiveSheet.Cells(1, lngColumna) = strTitulo
lngColumna = lngColumna + 1
Next Campo
.Range("A1").Select
.Range(.Selection, .Selection.End(xlToRight)).Select
.Selection.Font.Bold = True
With .Selection.Interior
.Pattern = xlSolid
.ColorIndex = 15
End With
End With

If Not (rstTituloTema.EOF And rstTituloTema.BOF) Then
xls.ActiveSheet.Cells(2, 1).CopyFromRecordset rstTituloTema
End If
xls.Columns("A:G").EntireColumn.AutoFit
rstNombrePrograma.MoveNext
Loop Until rstNombrePrograma.EOF
End If

xls.Application.DisplayAlerts = False
xls.ActiveWorkBook.Worksheets(strHoja).Delete

strArchivo = "D:\SG RADIO\EXPORTACIONES\" & DLookup("Emisora", "01TNomencladorEmisora") & " Derecho Autor Obras Completas.xls"
If Not Nz(strArchivo, "") = "" Then
xls.ActiveWorkBook.SaveAs FileName:=strArchivo, FileFormat:=xlNormal
Else
xls.ActiveWorkBook.Saved = True
End If
xls.Application.DisplayAlerts = True

cmdExportar_Click_Salir:
On Error Resume Next
xls.Quit
Set xls = Nothing
Set qdf = Nothing
CierraRecordsetDAO rstNombrePrograma
CierraRecordsetDAO rstTituloTema
On Error GoTo 0
Exit Sub
cmdExportar_Click_TratamientoErrores:
MsgBox "Error " & Err & " en proc.: cmdExportar_Click de Documento VBA: Form_frmFrmIniCaptacion (" & Err.Description & ")", vbCritical + vbOKOnly, "ATENCION"
Resume cmdExportar_Click_Salir
Resume Next
End Sub