I have an MS Access App that creates MS Excel Workbooks on a network share drive. After the workbook is created (using DoCmd.OutputTo), the Access application then opens each workbook and password protects it using the block of code below. However, each time it tries to SAVE AS, it states that “…there is already a file with the same name, do I want to overwrite it?” I want to replace the non-password protected file with the password protected file. How can I save the file with a password without the warning to overwrite?
Sub security1(ByVal strChDir As String, strFilename As String)
Dim Excel_App As Excel.Application
Dim Excel_Sheet As Object
Dim wbkNew As Excel.Workbook
Dim wksNew As Excel.Worksheet
Dim appExcel As Excel.Application
Dim fld As Field
Dim c As Long
Dim strExcel_Filename As String
Dim intNames As Integer
Dim strNames As String
Dim strRef As String
Dim x As Integer
‘password protect each workbook
‘open the workbook
Set Excel_App = CreateObject(“Excel.Application”)
‘ Uncomment this line to make Excel visible, if you want
Excel_App.Visible = True
‘passed in path and file name looks like this
‘ S:CLIENT_SERVICESDaily_ReportsClosedAccts_ABCInc_20081216.xls
strExcel_Filename = strChDir & strFilename & “.xls”
‘ Open the Excel spreadsheet.
Excel_App.Workbooks.Open FileName:=strExcel_Filename
Set wbkNew = Excel_App.ActiveWorkbook
‘ Check for later versions.
If Val(Excel_App.Application.Version) >= 8 Then
Set Excel_Sheet = Excel_App.ActiveSheet
Else
Set Excel_Sheet = Excel_App
End If
ChDir (strChDir)
‘===================================================================================
‘HERE IS THE PART THAT GIVES THE PROMPT THAT NEEDS TO BE AUTOMATICALLY ANSWERED…
wbkNew.SaveAs FileName:= _
“S:CLIENT_SERVICESDaily_Reports” & strFilename & “.xls”, FileFormat _
:=xlNormal, Password:=”some_password_here”, WriteResPassword:=””, ReadOnlyRecommended _
:=False, CreateBackup:=False
‘close the workbook
Excel_App.Workbooks(strFilename & “.xls”).Close SaveChanges:=True
Excel_App.Quit
‘housekeeping
Set Excel_Sheet = Nothing
Set Excel_App = Nothing
End Sub
