Password Protect Excel Workbook from MS Access - excel

I need to password protect entire workbook for opening. There's no need to protect the sheets as user will do some edits once reports are generated.Code runs within MS Access. Office Version is 2003. There's no possibility of using "SAVE AS" password protect method due to certain restrictions.
Can you please point out what I am doing wrong here?
Here's what I have tried so far:
Sub testProtection()
Dim xl As New Excel.Application
Dim wkbook As Workbook
Dim fileToOpen As String
On Error GoTo ExitMe
fileToOpen = "filepath & name"
Set wkbook = xl.Workbooks.Open(fileToOpen)
error in following lines: Automation Error Object invoked has disconnection from its client
wkbook.Protect Password:="100", Structure:=True, Windows:=True
wkbook.Close savechanges:=True
ExitMe:
MsgBox err.Description
Set xl = Nothing
Set wkbook = Nothing
Call cleanAllXLInstances
End Sub
PS: It's an incentive if the workaround could be compatible with MS 2010 as the tools will be migrated in the future - but not mandatory at this point. Plus I could manage it when looking at the API later on if current code can be worked out.

All I need to make sure, at this point Display Alerts = False to suppress the alerts for Saving As file with same name in same location. Which is contradictory to the initial constraints of the question asked though...
If xlPwd <> 0 Then
wkBook.SaveAs fileName:=fileToSaveAs, Password:=xlPwd, CreateBackup:=False
wkBook.Close
strMssg = " : Report is Protected!"
Else
strErrMssg = " : Report is NOT Protected!"
isWrapped = False
GoTo ExitMe
End If

Related

How to Close Excel application and workbook that is open and running in the background? [duplicate]

I have some code for exporting subform results to Excel workbook. Code works fine, only one small issue. If I do export, excel file opens If user wants I open. When this Excel file is opened and user wants to do Export again, I receive error 1004.
This error is produced because file is open, and new Excel object want to save a file with same name. What I want is when this happens, just cancel everything and let user know that he must first close this previously created workbook. Here is what I tried:
If Err.Number = 1004 Then
MsgBox "Error. You have opened Excel file, that has same name as this file name should be. Please close that file first !", vbCritical
Cancel = True
Set wb = Nothing ' wb is wb=XcelFile.Workbooks.Add
Set XcelFile = Nothing ' Xcelfile is Xcelfile= New Excel.Application
End If
This code works, when user closes that file, export can be performed - old file is just overwritted. Problem is that Excel application is still opened in Windows Task Manager, so Excel object is not properly closed.
Does anybody have a better solution ?
P.S.: I tried including numbers in file name of Excel, so that It wouldn't be same name, but I can't get It fixed.
EDIT: Here is how I tried changing filename
Dim i as Integer
ExcelFilename = "RESULTS_" & Format(Date, "dd/mm/yyyy") & "_" & i & "_" & ".xlsx"
i = i + 1
"i" doesn't change It's value when I run code once again. How can I make it increment ? This would solve my problem...
I suggest a simple solution: add the time to the file name to prevent conflicts.
ExcelFilename = "RESULTS_" & Format(Now(), "yyyy-mm-dd_hh-nn-ss") & ".xlsx"
For a number that will increment as long as the application is running, try
Static i As Integer
Static variables
You must be very strict in opening the Excel objects and closing them in reverse order - as done in this example:
Public Sub RenameWorkSheet()
Dim xls As Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Set xls = New Excel.Application
Set wkb = xls.Workbooks.Open("c:\test\workbook1.xlsx")
Set wks = wkb.Worksheets(1)
wks.Name = "My New Name"
wkb.Close True
Set wks = Nothing
Set wkb = Nothing
xls.Quit
Set xls = Nothing
End Sub

Create live copy of password protected excel workbook

I have a workbook that is password protected and I’d like to create a read only copy that other users can view on a different location on the network drive.
I know it’s a strange request as the other people could open the original as read only, but we don’t want them to know the location of the original or have anything to do with it, should they figure out my colleagues password.
The other issue we had was that people were opening as read only and it was still telling my colleague that it was locked by another user and he needs it for most of the day so that issue is annoying
Thanks in advance
What you could do is add the following event procedure to the ThisWorkbook module:
Const RemotePath As String = "D:\YourRemoteLocation\"
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
On Error GoTo CleanUp
If Success And InStr(ThisWorkbook.Name, "Copy of ") = 0 Then
Dim CopyFullName As String
CopyFullName = RemotePath & "Copy of " & ThisWorkbook.Name
Application.EnableEvents = False
Dim fso As FileSystemObject 'Requires the Microsoft Scripting Runtime Library
Set fso = New FileSystemObject
fso.CopyFile Source:=ThisWorkbook.FullName, Destination:=CopyFullName
Dim ReadOnlyWorkbook As Workbook
Set ReadOnlyWorkbook = Workbooks.Open(Filename:=CopyFullName)
Application.DisplayAlerts = False
ReadOnlyWorkbook.SaveAs Filename:=CopyFullName, Password:=""
Application.DisplayAlerts = True
ReadOnlyWorkbook.Close SaveChanges:=False
End If
CleanUp:
Application.EnableEvents = True
Application.DisplayAlerts = True
Set fso = Nothing
End Sub
This code will run every time the workbook is saved and export the current file to the remote location. Then it will open the copy and save it as a workbook without password.
Note that I've added InStr(ThisWorkbook.Name, "Copy of ") = 0 as a condition to the If-statement. Instr returns the position where a substring (arg2) appears in the main string (arg1) or zero if the substring is absent from the main string. In this context, we want it to be zero since we don't want to run the code in the workbook copy.
In this method, the owner of the original file will have to supply their password every time they save. You could automate this by passing the password as an argument to the Open method like this:
Set ReadOnlyWorkbook = Workbooks.Open( _
Filename:=CopyFullName, _
Password:="MyPassword")
However, the password would then be accessible by people looking into the VBA code.
Alternatively you could get the password from a local file that wouldn't be accessible from the Network, but then the file path would be visible.
And if the remote folder is not already set to be Read-only mode, you can make sure that people opening the remote version of the file do so in Read-Only mode by adding the following event procedure after the previous one.
Private Sub Workbook_Open()
If InStr(ThisWorkbook.Name, "Copy of ") = 0 Then
ThisWorkbook.ChangeFileAccess Mode:=xlReadOnly
End If
End Sub
Obviously this will only work if they enable macros.

The Updateing VBA Excel AddIn dilemma

I am doing a user application that needs an AddIn which I want to update in the workbook_open event.
Here is my plan:
Add Reference to "Microsoft Visual Basic for Applications Extensibility 5.3"
Delete Reference to old AddIn
Delete old AddIn if existing
Copy AddIn from different Folder
Add Reference to new AddIn
This should be done all while the vbProject is password protected and hidden. Here is my code:
Private Sub Workbook_Open()
Dim wb As Workbook
Set wb = Thisworkbook
'
If common_DB.AddFSOref(wb) Then Debug.Print "Added Extensibility"
If common_DB.AddRegEx(wb) Then Debug.Print "Added Regular Expressions"
UpdateDBAddin
End Sub
That is my update code that works without password protection but when adding in the reference in the vbProject password is required. I want to suppress that because my users do not have to worry about that.
Public Sub UpdateDBAddin()
Dim UserPath As String
Dim AI As AddIn
Dim AddinSourcePath As String
Dim AddinName As String
Dim Addintitle As String
Dim RefName As String
Dim ref As Reference
RefName = "Ex_Ample_Name"
AddinName = "ExampleName.xlam"
Addintitle = "Example AddIn"
UserPath = Application.UserLibraryPath
AddinSourcePath = "E:\Xample\Path\"
Application.DisplayAlerts = False
For Each ref In Thisworkbook.VBProject.References
If ref.Name = RefName Then
Thisworkbook.VBProject.References.remove ref
End If
Next ref
If Application.AddIns(Addintitle).IsOpen Then
Workbooks(AddinName).Close False
End If
If common_DB.IsFile(UserPath & "\" & AddinName) Then
Application.AddIns(Addintitle).Installed = False
Kill (UserPath & "\" & AddinName)
End If
Application.AddIns.Add (AddinSourcePath & AddinName)
Application.AddIns(Addintitle).Installed = True
Application.DisplayAlerts = True
' Here the VBProject Password is requested from the user, I want to suppress that
Thisworkbook.VBProject.References.AddFromFile (UserPath & "\" & AddinName)
End Sub
Question: How do I suppress the password when I want to add a new reference to my Vbproject?
EDIT1: Dilemma because it only occures when the project is hidden and I cannot 'debug' in the hold-mode. I narrowed the issue down to the adding of the reference to the addin on the last line of UpdateAddin.
EDIT2: This has some funnny behaviour. If you just Cancel the password prompt it works just fine. So the reference gets added. It doesn't matter if you put in the password or if you just cancle it the line gets executed.
So far I do not have a solution, but I found the workaround.
Just leave user to cancel password for a first time.
Reference will be added from file.
Then force the main xlsm to be Saved (can't be opened as ReadOnly)
Upon next run, check if correct reference with correct name and path is already referenced. if yes skip adding reference from file .. no password popup.
Anyway I am still looking for a solution how to avoid the first popup. Especially because our users are opening main XLSM in ReadOnly mode ..

opening Runtime Access from Excel VBA to Specific Form and Record

I have an Excel Workbook that provides a suite of reports. The data comes from an Access database, ole db connection etc.
I have a switchboard type screen on the main Excel worksheet, with buttons to view the various reports, and to open Access to an add new data form, and to an edit selected data form. I have all this working perfectly on my machine, with Full Access installed, using the following code in an Excel Module.
Sub OpenFormAmend()
Dim ac As Object
Dim strID As String
strID = Range("IniId").Value
On Error Resume Next
Set ac = GetObject(, "Access.Application")
If ac Is Nothing Then
Set ac = GetObject("", "Access.Application")
ac.OpenCurrentDatabase "C:\Database.accdb"
ac.DoCmd.OpenForm "frm_Amend", , , "ID =" & strID
ac.UserControl = True
Set ac = Nothing
End If
AppActivate "Microsoft Access"
ac.OpenCurrentDatabase "C:\Database.accdb"
ac.DoCmd.OpenForm "frm_Amend", , , "ID =" & strID
End Sub
This however doesn't do anything at all on a user's machine with Access Runtime only. I have been able to get the database to open with the following code pinched from a similar question here.
CreateObject("WScript.Shell").Run ("""C:\Database.accdb""")
But I have no clue how to go about getting the above open to the particular form, or to open to the selected record. Any help on getting started would be greatly appreciated!
You are calling GetObject() again after it has failed to return a currently running instance. Your second call should be to CreateObject().
Using On Error Resume Next is understandable before the first GetObject call, but you should turn on error reporting immediately afterwards (e.g. On Error Goto MyErrorHandler) otherwise you will have no idea what has gone wrong...

Access VBA - close Excel object

I have some code for exporting subform results to Excel workbook. Code works fine, only one small issue. If I do export, excel file opens If user wants I open. When this Excel file is opened and user wants to do Export again, I receive error 1004.
This error is produced because file is open, and new Excel object want to save a file with same name. What I want is when this happens, just cancel everything and let user know that he must first close this previously created workbook. Here is what I tried:
If Err.Number = 1004 Then
MsgBox "Error. You have opened Excel file, that has same name as this file name should be. Please close that file first !", vbCritical
Cancel = True
Set wb = Nothing ' wb is wb=XcelFile.Workbooks.Add
Set XcelFile = Nothing ' Xcelfile is Xcelfile= New Excel.Application
End If
This code works, when user closes that file, export can be performed - old file is just overwritted. Problem is that Excel application is still opened in Windows Task Manager, so Excel object is not properly closed.
Does anybody have a better solution ?
P.S.: I tried including numbers in file name of Excel, so that It wouldn't be same name, but I can't get It fixed.
EDIT: Here is how I tried changing filename
Dim i as Integer
ExcelFilename = "RESULTS_" & Format(Date, "dd/mm/yyyy") & "_" & i & "_" & ".xlsx"
i = i + 1
"i" doesn't change It's value when I run code once again. How can I make it increment ? This would solve my problem...
I suggest a simple solution: add the time to the file name to prevent conflicts.
ExcelFilename = "RESULTS_" & Format(Now(), "yyyy-mm-dd_hh-nn-ss") & ".xlsx"
For a number that will increment as long as the application is running, try
Static i As Integer
Static variables
You must be very strict in opening the Excel objects and closing them in reverse order - as done in this example:
Public Sub RenameWorkSheet()
Dim xls As Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Set xls = New Excel.Application
Set wkb = xls.Workbooks.Open("c:\test\workbook1.xlsx")
Set wks = wkb.Worksheets(1)
wks.Name = "My New Name"
wkb.Close True
Set wks = Nothing
Set wkb = Nothing
xls.Quit
Set xls = Nothing
End Sub

Resources