Consulting

Results 1 to 11 of 11

Thread: Workbook Password Protect

  1. #1

    Post Workbook Password Protect

    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

  2. #2
    VBAX Master Aflatoon's Avatar
    Joined
    Sep 2009
    Location
    UK
    Posts
    1,720
    Location
    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"
    Be as you wish to seem

  3. #3
    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

  4. #4
    VBAX Master Aflatoon's Avatar
    Joined
    Sep 2009
    Location
    UK
    Posts
    1,720
    Location
    What's the problem exactly, apart from the fact you try to use the Password property of a workbook you just closed?
    Be as you wish to seem

  5. #5
    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?

  6. #6
    VBAX Master Aflatoon's Avatar
    Joined
    Sep 2009
    Location
    UK
    Posts
    1,720
    Location
    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.
    Be as you wish to seem

  7. #7
    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.

  8. #8
    VBAX Master Aflatoon's Avatar
    Joined
    Sep 2009
    Location
    UK
    Posts
    1,720
    Location
    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
    Be as you wish to seem

  9. #9
    VBAX Master Aflatoon's Avatar
    Joined
    Sep 2009
    Location
    UK
    Posts
    1,720
    Location
    By the way, you should tell people when you cross-post: http://www.excelforum.com/showthread.php?t=1167437
    Be as you wish to seem

  10. #10
    Wow! Thank you so much and it works

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

  11. #11
    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

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •