#1
|
|||
|
|||
Open Excel from MS Access and Password Protect Workbook
All.
I am trying to open a excel file password protect it then email out as attachment. Everything works fine except I can't password protect the workbook. Below is my code. Code:
Private Sub cmdRun_Click() Dim strSQL As String Dim strReportLocation As String Dim qd As QueryDef Dim db As Database Dim rs As DAO.Recordset Dim appOutLook As Outlook.Application Dim MailOutLook As Outlook.MailItem Dim xl As New Excel.Application Dim wkbook As Workbook Dim fileToOpen As String On Error GoTo err_handler User = CreateObject("wscript.Network").UserName DoCmd.SetWarnings False 'Open the Email Distribution List Set db = CurrentDb Set rs = db.OpenRecordset("SELECT TAXID, EMAIL FROM LIST") 'Loop through distribution list and send member detail to excel file If Not (rs.EOF And rs.BOF) Then Do Until rs.EOF On Error Resume Next strSQL = "SELECT [MEMBER], [PAID], [email] FROM Rpt WHERE [TAXID] = " & rs![TAXID] Set qd = CurrentDb.CreateQueryDef("Email_Provider_Incentive", strSQL) strReportLocation = "C:\Users\" & User & "\Desktop\Provider_Incentive" & Format(Date, "mmddyy") & ".xls" DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "Email_Provider_Incentive", strReportLocation, True CurrentDb.QueryDefs.Delete "Email_Provider_Incentive" xl.DisplayAlerts = False Set wkbook = xl.Workbooks.Open(strReportLocation) fileToSaveAs = "Provider_Incentive" & Format(Date, "mmddyy") & ".xls" ActiveWorkbook.SaveAs FileName:=fileToSaveAs, Password:="ANTHEM" ActiveWorkbook.Close xl.DisplayAlerts = True 'Send email with attached excel workbook created above Set appOutLook = CreateObject("Outlook.Application") Set MailOutLook = appOutLook.CreateItem(olMailItem) With MailOutLook .BodyFormat = olFormatRichText .To = rs![email] .Subject = "[SECURE] Provider Incentive Auto email TEST" .HTMLBody = "This is a TEST of the Provider Incentive Auto Email" .Attachments.Add (strReportLocation) .Send End With rs.MoveNext 'Move to the next TAXID Loop Else MsgBox "There are no Records to process" End If rs.Close 'Close the recordset Set rs = Nothing 'Clean up Set xl = Nothing Set wkbook = Nothing DoCmd.SetWarnings True MsgBox "The Automated Provider Email process has completed." Exit Sub err_handler: rs.Close 'Close the recordset Set rs = Nothing 'Clean up Set xl = Nothing Set wkbook = Nothing DoCmd.SetWarnings True MsgBox Err.Number & Err.Description End Sub |
#2
|
|||
|
|||
Hi,
A bit of code you may try. Not tested. Code:
With ActiveWorkbook .SaveAs FileFormat:=xlNormal, Password:="YourPassword", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False .Close End With |
#3
|
||||
|
||||
You should be using your wkbook variable and not ActiveWorkbook, and you should specify the file format as well:
Code:
wkbook.SaveAs FileName:=fileToSaveAs, FileFormat:=56, Password:="ANTHEM" wkbook.Close |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Protect a workbook without using a password. | aussiemight | Excel | 3 | 04-26-2017 07:32 PM |
how to create a box in word document that takes a password to open an access field | kawtharz | Word VBA | 2 | 08-13-2015 12:43 AM |
Need to open an Excel WorkBook from Word VBA | Pierre-Hugues | Word VBA | 4 | 10-07-2013 06:27 AM |
Unable to open Excel 97-2003 workbook | J Partridge | Excel | 1 | 11-07-2010 03:26 AM |
password protect excel file? | Dawg751 | Excel | 2 | 01-28-2010 06:23 AM |