exportar tablas de Access a Excel

Soy aprendiz de hacer base de datos, hice una base de datos que se usa en varios lugares, ella exporta tablas en Excel que son importadas en un consolidador, detecté que hubo alguien que modificó unas tablas manualmente para dar por concluida la información y ello dio diferencia, quiero exportarlas con contraseña y no se como hacerlo, son dos tipos de exportaciones y se las detallo para mejor comprensión

esto es adaptado a mis necesidades desde ejemplos que encontré en la web

primera

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 'Excel.Application

' declaración de constantes de Excel para así evitar hacer referencia a este

Const xlWBATWorksheet = -4167

Const xlAutomatic = -4105

Const xlSolid = 1

Const xlThemeColorDark1 = 1

Const xlToRight = -4161

Const xlNormal = -4143

On Error GoTo cmdExportar_Click_TratamientoErrores

' abro un recordset con los pedidos y otro con los comerciales

strSQL = "SELECT NombrePrograma"

strSQL = strSQL & " FROM ProgramasEmitidos"

strSQL = strSQL & " GROUP BY NombrePrograma"

' creo una instancia a Excel

Set xls = CreateObject("Excel.Application")

xls.Visible = True

' creo un libro con una sola hoja

xls.Workbooks.Add xlWBATWorksheet

strHoja = xls.ActiveSheet.Name

Set rstNombrePrograma = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)

' recorro el recordset de los comerciales

If Not (rstNombrePrograma.EOF And rstNombrePrograma.BOF) Then

   Do

      ' en esta ocasión voy a utilizar una consulta de parámetros y construyo una sentencia SQL para cada comercial

      strSQL = "SELECT TituloTema, NombreAutor, NombreInterprete, Sonatas, Fecha, Calculo, Local, Plantilla "

      strSQL = strSQL & "FROM ProgramasEmitidos"

      strSQL = strSQL & " WHERE NombrePrograma = Parametro1"

      Set qdf = CurrentDb.CreateQueryDef("", strSQL)

      ' doy valor a los parámetros sin preocuparme de los tipos de datos

      qdf.Parameters("Parametro1") = rstNombrePrograma!NombrePrograma

      ' añado una hoja por cada comercial

      Set rstTituloTema = qdf.OpenRecordset

      xls.ActiveWorkBook.Sheets.Add Before:=xls.Worksheets(xls.Worksheets.Count)

      xls.ActiveSheet.Name = rstNombrePrograma!NombrePrograma

      ' cabecera de columnas

      With xls

         lngColumna = 1

         For Each Campo In rstTituloTema.Fields

            strTitulo = ""

            ' como yo suelo utilizar en el nombre de campo varias palabras sin espacios y empezando cada una

            ' de ellas por mayúscula, para separarlas y mostrar las cabeceras correctas, inserto un espacio

            ' delante de cada mayúscula (que no sea la de inicio)

            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

      ' escribo los datos en la hoja

      If Not (rstTituloTema.EOF And rstTituloTema.BOF) Then

         xls.ActiveSheet.Cells(2, 1).CopyFromRecordset rstTituloTema

      End If

      ' ajusto el tamaño de las columnas

      xls.Columns("A:G").EntireColumn.AutoFit

      rstNombrePrograma.MoveNext

   Loop Until rstNombrePrograma.EOF

End If

' elimino la hoja vacía

' evito que me pregunte si estoy seguro

xls.Application.DisplayAlerts = False

xls.ActiveWorkBook.Worksheets(strHoja).Delete

' pregunto el nombre del archivo a guardar

strArchivo = "D:\SG RADIO RCH\EXPORTACIONES\11 Derecho Autor Obras Completas R Chaparra.xls"

' lo guardo con el nombre indicado y formato xls (97-2003)

If Not Nz(strArchivo, "") = "" Then

   xls.ActiveWorkBook.SaveAs FileName:=strArchivo, FileFormat:=xlNormal

Else

   ' si se ha cancelado y por tanto no se ha dado nombre al archivo,

   ' "engaño" a Excel haciendole "pensar" que ya está guardado, de ese modo no me preguntará si quiero guardar

   xls.ActiveWorkBook.Saved = True

End If

xls.Application.DisplayAlerts = True

cmdExportar_Click_Salir:

   ' cierro todo

   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_frmFrmIniInformes (" & Err.Description & ")", vbCritical + vbOKOnly, "ATENCION"

   Resume cmdExportar_Click_Salir

Resume Next

End Sub        ' cmdExportar