Password Protect Excel File (1 Viewer)

Tim L

Tim L

Registered User.
Local time
Today, 03:25
Joined
Sep 6, 2002
Messages
414
I'm using TransferSpreadsheet to export tables from my dB. Is it possible to password protect the Excel file?

I've carried out a search in Modules & VBA but did not find any satisfactory answers, although the posts were all quite old and I figure that someone may have come across and answer by now. I've got Access/Excel 2003.

Tim
 
ghudson

ghudson

Registered User.
Local time
Yesterday, 22:25
Joined
Jun 8, 2002
Messages
6,195
Untested but this should do it...

Code: 
Public Sub Testing(sFile As String)
On Error GoTo Err_Testing

    Dim xlApp As Object
    Dim xlSheet As Object

    Set xlApp = CreateObject("Excel.Application")
    Set xlSheet = xlApp.Workbooks.Open(sFile).Sheets(1)
    
    With xlApp

    'Password protext the active worksheet    
    .Application.ActiveSheet.Protect "xxx", UserInterfaceOnly:=True

    'Password protect the workbook strcuture
    .Application.ActiveWorkbook.Protect "xxx", Structure:=True, Windows:=False

    'Password protect the file [OnOpen password]
    .Application.DisplayAlerts = False
    .Application.ActiveWorkbook.SaveAs FileName:=sFile, Password:="xxx", WriteResPassword:="xxx"
    .Application.DisplayAlerts = True

    .Application.ActiveWorkbook.Save
    .Application.ActiveWorkbook.Close
    .Quit

    End With

    Set xlApp = Nothing
    Set xlSheet = Nothing

Exit_Testing:
    Exit Sub

Err_Testing:
    MsgBox Err.Number & " - " & Err.Description
    Resume Exit_Testing
 
Last edited:
Tim L

Tim L

Registered User.
Local time
Today, 03:25
Joined
Sep 6, 2002
Messages
414
ghudson, thanks for the quick reply.

ghudson said:
Untested but this should do it...
Click to expand...
Erm, might do, got a question though...

There's an "End If" but no start, so what was the "If" statement and where should it be?

Cheers,

Tim
 
Tim L

Tim L

Registered User.
Local time
Today, 03:25
Joined
Sep 6, 2002
Messages
414
Okay, tried the code now, password successfully set. Thanks for that.

There is a problem though:

The procedure warns about replacing the current file... which has already been created (eg: it could be a file with appended data and therefore can't be deleted prior to this operation). It doesn't actually replace the file, which is okay I suppose, unless that is what you were expecting to happen, but there are two issues:
  1. I would rather not have the warning message displayed (DoCmd.SetWarnings (False) has no effect).
  2. There is also the problem that if the user selects the No or Cancel option when the warning is presented then the file will not be password protected (and maybe leaves a locked file behind, which then can't be replaced the next time the procedure is envoked, although I suppose that this could be cated for in the OnErr event...).
So how do we force a 'yes'?

Tim
 
Last edited:
tkpstock

tkpstock

Cubicle Warrior
Local time
Yesterday, 22:25
Joined
Feb 25, 2005
Messages
206
Just kill the file before saving a new copy.

Code: 
Kill "pathname/filename.xls"
 
Tim L

Tim L

Registered User.
Local time
Today, 03:25
Joined
Sep 6, 2002
Messages
414
tkpstock said:
Just kill the file before saving a new copy.

Code: 
Kill "pathname/filename.xls"
Click to expand...

Thanks Tom, unfortunately the original file needs to remain and this command deletes the file; no good adding data to a file then promptly deleting it, all the data will be gone :-(

Tim
 
tkpstock

tkpstock

Cubicle Warrior
Local time
Yesterday, 22:25
Joined
Feb 25, 2005
Messages
206
Sorry, didn't read closely enough.

Instead of using SaveAs, just use Save - the file already exists, so you don't have to use SaveAs. This shouldn't prompt for anything.
 
ghudson

ghudson

Registered User.
Local time
Yesterday, 22:25
Joined
Jun 8, 2002
Messages
6,195
I fixed my code above to disable the Excel warning message that asks the user if they want to replace the file.
 
D

Db-why-not

Registered User.
Local time
Yesterday, 21:25
Joined
Sep 17, 2019
Messages
159
ghudson said:
Untested but this should do it...

Code: 
Public Sub Testing(sFile As String)
On Error GoTo Err_Testing

    Dim xlApp As Object
    Dim xlSheet As Object

    Set xlApp = CreateObject("Excel.Application")
    Set xlSheet = xlApp.Workbooks.Open(sFile).Sheets(1)
    
    With xlApp

    'Password protext the active worksheet    
    .Application.ActiveSheet.Protect "xxx", UserInterfaceOnly:=True

    'Password protect the workbook strcuture
    .Application.ActiveWorkbook.Protect "xxx", Structure:=True, Windows:=False

    'Password protect the file [OnOpen password]
    .Application.DisplayAlerts = False
    .Application.ActiveWorkbook.SaveAs FileName:=sFile, Password:="xxx", WriteResPassword:="xxx"
    .Application.DisplayAlerts = True

    .Application.ActiveWorkbook.Save
    .Application.ActiveWorkbook.Close
    .Quit

    End With

    Set xlApp = Nothing
    Set xlSheet = Nothing

Exit_Testing:
    Exit Sub

Err_Testing:
    MsgBox Err.Number & " - " & Err.Description
    Resume Exit_Testing
Click to expand...

How would I integrate/ modify this code within my existing code. I have a button, that is clicked and exports several queries into 1 excel workbook with several sheets. I want the whole excel workbook to have 1 password. Below is my existing code:private Sub CommandTransfer_Click()On Error GoTo SubErrorstrPath = "M:\Research\Lung Us\Data\Exporting_OHSU\OHSU_BAMC_Lung_Point_Clinical_Database_" & "_" & Format(Date, "yyyy_mm_dd") & ".xlsx"DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "OHSU_Admission_dx", strPathDoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "OHSU_DC_DX", strPathDoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "OHSU_CXR_CT", strPathDoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "OHSU_pre_existing", strPathDoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "OHSU_Demographics", strPathDoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "OHSU_Qualifying_cond", strPathDoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "OHSU_Micro", strPathDoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "OHSU_New_Pulm", strPathDoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "OHSU_US_scans", strPathDoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "OHSU_Box_Uploads", strPathDoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "OHSU_US_Review", strPathMsgBox "File Exported successfully", vbInformation + vbOKOnly, "Export Success" SubExit: Exit Sub SubError: MsgBox "Error Number: " & Err.Number & "= " & Err.Description, vbCritical + vbOKOnly, "An error occured" GoTo SubExitEnd SubAny help would be appreciated. Thank you.
 
theDBguy

theDBguy

I’m here to help
Staff member
Local time
Yesterday, 19:25
Joined
Oct 29, 2018
Messages
21,455
Db-why-not said:
How would I integrate/ modify this code within my existing code. I have a button, that is clicked and exports several queries into 1 excel workbook with several sheets. I want the whole excel workbook to have 1 password. Below is my existing code:private Sub CommandTransfer_Click()On Error GoTo SubErrorstrPath = "M:\Research\Lung Us\Data\Exporting_OHSU\OHSU_BAMC_Lung_Point_Clinical_Database_" & "_" & Format(Date, "yyyy_mm_dd") & ".xlsx"DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "OHSU_Admission_dx", strPathDoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "OHSU_DC_DX", strPathDoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "OHSU_CXR_CT", strPathDoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "OHSU_pre_existing", strPathDoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "OHSU_Demographics", strPathDoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "OHSU_Qualifying_cond", strPathDoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "OHSU_Micro", strPathDoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "OHSU_New_Pulm", strPathDoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "OHSU_US_scans", strPathDoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "OHSU_Box_Uploads", strPathDoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "OHSU_US_Review", strPathMsgBox "File Exported successfully", vbInformation + vbOKOnly, "Export Success" SubExit: Exit Sub SubError: MsgBox "Error Number: " & Err.Number & "= " & Err.Description, vbCritical + vbOKOnly, "An error occured" GoTo SubExitEnd SubAny help would be appreciated. Thank you.
Click to expand...
Hi. This is almost a 15-yr old thread. I suggest you start a new one for you question. Just a thought...
 
Last edited:
You must log in or register to reply here.

Similar threads

zelarra821
Solved Accede file
Replies
13
Views
929
isladogs
isladogs
H
Unzip password protected file
Replies
8
Views
1,136
Harris@Z
H
S
Solved Issue with acDialog on Adding a Record
Replies
4
Views
496
ebs17
E
mloucel
Solved Log routine issue
Replies
4
Views
336
pbaldy
pbaldy
B
Solved Problems exporting text file
Replies
14
Views
1,621
CarlettoFed
C

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom