Need help unprotecting destination file when pasting from another workbook

[orsettgreenboy]

Hi there, I have the below code which does several things just fine, but now I have to change it because the destination file I'm copying to needs to be password protected by me.

I've uploaded a picture of the type of password (will be the one to modify) here:

https://docs.google.com/leaf?id=0B5...OWRlOC00M2VmLWIyODMtYzNjZDEyNjBjYjgy&hl=en_US

I don't really know anything about VBA and so I was guessing where/ how to do this, but my attempts below have failed. I have made the font red where my attempts were added below.

Hope someone can help

Thank you

Orsettgreenboy

      Option Explicit
 
 
 
 
Sub SvMe() 'Generate next number to B5 and Save filename as value of G9 then save onto P drive and email copy to me
Sheet1.Unprotect Password:="Monkey"
Range("B5") = Range("B5") + 1
Sheet1.Protect Password:="Monkey"
ActiveWorkbook.Save
    Dim newFile As String, fName As String
 
    fName = Range("G9").Value
    newFile = fName
 
    ActiveWorkbook.SaveAs FileName:="P:\Quality\Non Conformances\" & newFile, FileFormat:=IIf(Application.Version >= "12", 56, -4143)
    Dim wb As Workbook
    Dim I As Long
    Set wb = ActiveWorkbook
    If Val(Application.Version) >= 12 Then
        If wb.FileFormat = 51 And wb.HasVBProject = True Then
            MsgBox "There is VBA code in this xlsx file, there will" & vbNewLine & _
                   "be no VBA code in the file you send. Save the" & vbNewLine & _
                   "file first as xlsm and then try the macro again.", vbInformation
            Exit Sub
        End If
    End If
    On Error Resume Next
    For I = 1 To 3
        wb.SendMail "rg@xxx", _
                    fName
                    If Err.Number = 0 Then Exit For
    Next I
    On Error GoTo 0
 
    Dim wkb As Workbook, wks As Worksheet, LastRow As Long
    Dim FilePath As String, FileName As String
    Dim ws As Worksheet, blnOpened As Boolean
    FilePath = "P:\Quality\"
    FileName = "Non Conformance Log.xls"
    Call ToggleEvents(False)
    Set ws = ThisWorkbook.Sheets("Input")
    If WbOpen(FileName) = True Then
        Set wkb = Workbooks(FileName)
        blnOpened = False
    Else
        If Right(FilePath, 1) <> Application.PathSeparator Then
            FilePath = FilePath & Application.PathSeparator
        End If
        Set wkb = Workbooks.Open(FilePath & FileName)
        blnOpened = True
    End If
    Set wks = wkb.Sheets("Sheet1")
    [COLOR=red]Sheet1.Unprotect Password:="Monkey"[/COLOR]
    LastRow = wks.Cells.Find(what:="*", after:=wks.Cells(1, 1), searchorder:=xlByRows, searchdirection:=xlPrevious).Row + 1
    wks.Cells(LastRow, "C").Value = ws.Cells(5, "B").Value
    wks.Cells(LastRow, "D").Value = ws.Cells(7, "B").Value
    wks.Cells(LastRow, "E").Value = ws.Cells(9, "B").Value
    wks.Cells(LastRow, "F").Value = ws.Cells(11, "B").Value
    wks.Cells(LastRow, "G").Value = ws.Cells(13, "B").Value
    wks.Cells(LastRow, "H").Value = ws.Cells(15, "B").Value
    wks.Cells(LastRow, "I").Value = ws.Cells(17, "B").Value
    wks.Cells(LastRow, "J").Value = ws.Cells(19, "B").Value
    wks.Cells(LastRow, "K").Value = ws.Cells(21, "B").Value
    wks.Cells(LastRow, "L").Value = ws.Cells(23, "B").Value
    wks.Cells(LastRow, "M").Value = ws.Cells(25, "B").Value
    wks.Cells(LastRow, "N").Value = ws.Cells(27, "B").Value
    wks.Cells(LastRow, "O").Value = ws.Cells(29, "B").Value
    wks.Cells(LastRow, "P").Value = ws.Cells(31, "B").Value
    wks.Cells(LastRow, "Q").Value = ws.Cells(33, "B").Value
    wks.Cells(LastRow, "B").Value = ws.Cells(9, "G").Value
    If blnOpened = True Then
        wkb.Close SaveChanges:=True
    End If
    [COLOR=red]Sheet1.Protect Password:="Monkey"[/COLOR]
    Call ToggleEvents(True)
 
  End Sub
 
 
Sub ToggleEvents(blnState As Boolean)
'Originally written by firefytr
    With Application
        .DisplayAlerts = blnState
        .EnableEvents = blnState
        .ScreenUpdating = blnState
        If blnState Then .CutCopyMode = False
        If blnState Then .StatusBar = False
    End With
End Sub
Function WbOpen(wbName As String) As Boolean
'Originally found written by Jake Marx
    On Error Resume Next
    WbOpen = Len(Workbooks(wbName).Name)
End Function

 

[Andrew Poulsom]

Have you tried?

wks.Unprotect Password:="Monkey"

 

[orsettgreenboy]

thanks andrew,

I've changed the code as you suggested but this doesn't work - now gives me following error:

https://docs.google.com/open?id=0B5DAfazTLnjfMGFlZWNiOGEtN2MxNi00OTRjLWE0N2UtOWFjZjFmYTk5NGIw

Thanks
Orsettgreenboy

 

[Andrew Poulsom]

Which line is causing that error?

 

[orsettgreenboy]

Hi Andrew

Thanks for your continued assistance

I have used the debug and stepped through to following location as per screen shot in the link below

https://docs.google.com/open?id=0B5DAfazTLnjfZThkYjhkOTctY2U5Yy00MDU5LWI2NTMtYWM3YThiNmNkZDg2

You will notice that I changed it to wb rather than ws, as the protection is on the workbook not the worksheet.

The file opens okay but with request for the password as per below
https://docs.google.com/open?id=0B5DAfazTLnjfODlhNjg4YmItOWRlOC00M2VmLWIyODMtYzNjZDEyNjBjYjgy

Hopefully the vba can include the right code with the password in the right place to bypass this.

Hope you can help again

Thanks a lot

Orsettgreenboy

 

[Andrew Poulsom]

You can provide the password like this:

Set wkb = Workbooks.Open(FilePath & FileName, WriteResPassword:="Monkey")

That's for a password to modify. For a password to open it's:

Set wkb = Workbooks.Open(FilePath & FileName, Password:="Monkey")

 

[orsettgreenboy]

Well thanks sooooo Much Andrew.

That works just fine

Orsettgreenboy