PDA

View Full Version : Workbook Password Protect



JackMouct
12-21-2016, 08:53 AM
Hi Everyone,

I am not sure what is wrong with these code but workbook does not ask for password when i open. Please see below

Any help will be appreciated





With New_Wkbk
New_Wkbk.SaveAs rCell_Summary.Value & " " & Format(Date, "mmmm yyyy")
Application.DisplayAlerts = False
Set thisWb = ActiveWorkbook
With thisWb
ActiveWorkbook.Protect Password:="SSC", Structure:=True, Windows:=False
ActiveWorkbook.SaveAs fileName:=thisWb.Path
ActiveWorkbook.Close savechanges:=False
End With
Application.DisplayAlerts = True

Aflatoon
12-22-2016, 02:31 AM
The password you set is not the password to open the workbook, it's the one that controls whether or not you can change the structure or resize windows. The open password is set using the SaveAs method's Password parameter:


ActiveWorkbook.SaveAs fileName:=thisWb.Path , Password:="SSC"

JackMouct
12-22-2016, 05:02 AM
Hi, Thank you for your help and i have tried your method but is still not working. Please see below full code and may be i have messed up the whole coding and if you don't mind tidy up please.

Dim Master_Sht As Worksheet, Summary_Sht As Worksheet, New_Sht As Worksheet, Third_Sht As WorksheetDim rCell_Summary As Range, rCell_ThirdReports As Range
Dim Summary_Last_Row As Long, New_Sht_Next_Row As Long
Dim Total1 As Double
Dim New_Wkbk As Workbook, thisWb As Workbook
Dim fileName As String, Password As String


Application.ScreenUpdating = False

Set Master_Sht = Sheets("Third Reports")
Set Summary_Sht = Sheets("Summary")
Set Third_Sht = Sheets("Third Reports")
Summary_Last_Row = Summary_Sht.Cells(Rows.Count, "A").End(xlUp).Row

For Each rCell_Summary In Summary_Sht.Range("A2:A" & Summary_Last_Row)
Set New_Wkbk = Workbooks.Add
Set New_Sht = New_Wkbk.Sheets(1)


With New_Sht
.Name = rCell_Summary.Value
.Range("A1").Value = "Pers.No."
.Range("B1").Value = "Last name First name"
.Range("C1").Value = "Name of employee or applicant"
.Range("D1").Value = "ID number"
.Range("E1").Value = "Wage Type Long Text"
.Range("F1").Value = "Amount"
.Range("G1").Value = "Crcy"

End With

For Each rCell_ThirdReports In Third_Sht.Range("E2:E100000")
If rCell_ThirdReports.Value = rCell_Summary.Value Then
New_Sht_Next_Row = Application.WorksheetFunction.CountA(New_Sht.Range("A:A")) + 1
New_Sht.Cells(New_Sht_Next_Row, 1).Resize(, 6).Value = Third_Sht.Cells(rCell_ThirdReports.Row, 1).Resize(, 6).Value 'a bit quicker
End If
Next rCell_ThirdReports

Set New_Wkbk = ActiveWorkbook


With New_Sht

Total1 = Application.WorksheetFunction.Sum(.Range("F:F"))

.Cells(New_Sht_Next_Row + 2, 6).Value = Total1
.Rows(1).Font.Bold = True
.UsedRange.Columns.AutoFit

End With

With New_Wkbk

New_Wkbk.SaveAs rCell_Summary.Value & " " & Format(Date, "mmmm yyyy")


Application.DisplayAlerts = False

Set thisWb = ActiveWorkbook

With thisWb

.SaveAs fileName:=thisWb.Path, Password:="SSC"

.Close savechanges:=False
.Password = "SSC"




End With




Application.DisplayAlerts = True


'New_Wkbk.SaveAs fileName:="G:\Central Services\Retails Sales\Controls\Control Reports\Third Party\December 2016, & "".xls"", FileFormat:=xlNormal, Password:=""SSC"", WriteResPassword:="", ReadOnlyRecommended:=False,CreateBackup:=False"

End With


Next rCell_Summary


Set Master_Sht = Nothing
Set Summary_Sht = Nothing
Set Third_Sht = Nothing
Set New_Sht = Nothing


Application.CutCopyMode = False


Application.ScreenUpdating = True






End Sub

Aflatoon
12-22-2016, 05:07 AM
What's the problem exactly, apart from the fact you try to use the Password property of a workbook you just closed?

JackMouct
12-22-2016, 05:26 AM
That is not other problem apart from password protect issue. Are you saying that if i close the code workbook then it will work then?

Aflatoon
12-22-2016, 05:38 AM
I'm asking what the problem actually is with that code?

The part I was referring to is here:

With thisWb

.SaveAs fileName:=thisWb.Path, Password:="SSC"


.Close savechanges:=False
.Password = "SSC"


In that code you close the workbook and then try to set its password, which makes no sense to me, especially as you already saved it with a password.

JackMouct
12-22-2016, 05:56 AM
Sorry, this is nothing wrong with that code itself with no error message but the save workbook files can be opened with no password require which i want, as the workbook needs to be sent to relevant people and it contains confidentiality information . To be honest i am fairly new with VBA coding, so there is lot to learn. i am hoping if you could please take look at the whole coding and advise where it went wrong. Thank you and any help will be much appreciated.

Aflatoon
12-22-2016, 06:08 AM
Try this variation:



Dim Master_Sht As Worksheet, Summary_Sht As Worksheet, New_Sht As Worksheet, Third_Sht As Worksheet
Dim rCell_Summary As Range, rCell_ThirdReports As Range
Dim Summary_Last_Row As Long, New_Sht_Next_Row As Long
Dim Total1 As Double
Dim New_Wkbk As Workbook, thisWb As Workbook
Dim theFileName As String, Password As String
Application.ScreenUpdating = False
Set Master_Sht = Sheets("Third Reports")
Set Summary_Sht = Sheets("Summary")
Set Third_Sht = Sheets("Third Reports")
Summary_Last_Row = Summary_Sht.Cells(Rows.Count, "A").End(xlUp).Row
For Each rCell_Summary In Summary_Sht.Range("A2:A" & Summary_Last_Row)
Set New_Wkbk = Workbooks.Add
Set New_Sht = New_Wkbk.Sheets(1)
With New_Sht
.Name = rCell_Summary.Value
.Range("A1").Value = "Pers.No."
.Range("B1").Value = "Last name First name"
.Range("C1").Value = "Name of employee or applicant"
.Range("D1").Value = "ID number"
.Range("E1").Value = "Wage Type Long Text"
.Range("F1").Value = "Amount"
.Range("G1").Value = "Crcy"
End With
For Each rCell_ThirdReports In Third_Sht.Range("E2:E100000")
If rCell_ThirdReports.Value = rCell_Summary.Value Then
New_Sht_Next_Row = Application.WorksheetFunction.CountA(New_Sht.Range("A:A")) + 1
New_Sht.Cells(New_Sht_Next_Row, 1).Resize(, 6).Value = Third_Sht.Cells(rCell_ThirdReports.Row, 1).Resize(, 6).Value 'a bit quicker
End If
Next rCell_ThirdReports
With New_Sht
.Cells(New_Sht_Next_Row + 2, 6).Value = Application.WorksheetFunction.Sum(.Range("F:F"))
.Rows(1).Font.Bold = True
.UsedRange.Columns.AutoFit
End With
With New_Wkbk
theFileName = rCell_Summary.Value & " " & Format(Date, "mmmm yyyy")
If Dir(theFileName) <> vbNullString Then Kill theFileName
.SaveAs fileName:=theFileName, Password:="SSC"
.Close savechanges:=False
End With
Next rCell_Summary
Set Master_Sht = Nothing
Set Summary_Sht = Nothing
Set Third_Sht = Nothing
Set New_Sht = Nothing
Application.CutCopyMode = False
Application.ScreenUpdating = True

Aflatoon
12-22-2016, 06:26 AM
By the way, you should tell people when you cross-post: http://www.excelforum.com/showthread.php?t=1167437

JackMouct
12-22-2016, 06:28 AM
Wow! Thank you so much and it works:rotlaugh:

You are a life saver. Thank you so much
You are a :stars:

JackMouct
12-22-2016, 05:30 PM
Hello again!

What is the best code to send these workbooks save and password protect as attachment to different recipient though outlook inbox? any helps will be much appreciated.
Thank you again for all your helps