Help with Password

[sanyup2000]

When I run the macro, How do I unprotect the workbook and worksheets automatically , and then protect them again via VBA when the macro has been completely run?


Can anyone help ?

To Run the macro:
1. Save the Template on C:\ as Template1.xls
2. Click Run on TestMacro.xls
3. Select SourceFile3.xls to process
4. File is saved at C:\

File is saved at:

http://www.vbaexpress.com/forum/showthread.php?t=16391

Thanks

 

[Gavona]

Use the macro recorder and do it manually. Then examine the code it has stored. Post back with any difficulties.

Gavin

 

[sanyup2000]

I have not been able to figure out with recording. SO, i posted it here. It breaks down on Protect/Unprotect line of code.iF i run without the protect/unprotect, the code runs just fine.

 

[Gavona]

Post the code you have got. What version of Excel?

Gavin

 

[Gavona]

From vba help:
expression.Unprotect(Password)

expression could be your sheet or your workbook.

Also look up "Protect Method"

Gavin

 

[sanyup2000]

Here is my code. The workbook and worksheet p/w is same.


Option Explicit
Const mc_strTEMPLATE_FILE_PATH As String = "C:\Template.xls"
Const Password As String = "Valuation"

Dim mwbMacro As Workbook
Dim mwbAddressesReport As Workbook
Dim mwbLoanActivityReport As Workbook
Dim mwbLoanActivityAdditionalDatesReport As Workbook
Dim maFileName As Variant
Dim mbErrorSwitch As Boolean
Dim miInvoiceCount As Integer
Dim miCounter As Integer
Dim mdStatementDateBegin As Date
Dim mdStatementDateEnd As Date
Dim lsTitle As String
Dim lsFileName As String
Dim lsSavePath As String
Dim lrGSNStartRange As Range
Dim lrAccountsProcessedRange As Range
Dim lrCopyStartRange As Range
Dim lrPasteRange As Range
Dim lrFormulaRange As Range
Dim lrTransactionDetailRange As Range
Dim liBeginningBalance As Double
Dim liEndingBalance As Double
Dim liTransactionCounter As Integer
Dim ldCopyEffectiveDate As Date
Dim ldPasteEffectiveDate As Date
Dim mwbStaticReport As Workbook
Dim mwbInvoice As Workbook





Sub Selectfiletoprocess()
'************************************************************************** ***************
'Name: GetUserInput
'Description:
'Arguments:
'Author:
'Changes:
'************************************************************************** ***************
Dim lngIndex As Long
Dim rngCopy As Range

'Prepare Macro
Set mwbMacro = ThisWorkbook


'Check to ensure User Inputs are in Macro
If mwbMacro.Names("nrSavePath").RefersToRange.Value = "" Then

MsgBox prompt:="Please input Save Path", Title:="Error"
Exit Sub
End If


'Set Save Path
lsSavePath = mwbMacro.Names("nrSavePath").RefersToRange.Value
If Right(lsSavePath, 1) <> "\" Then
lsSavePath = lsSavePath & "\"
End If



With Sheet1
' This will pick all used cells from A13 down.
Set rngCopy = .Range(.Cells(13, "A"), .Cells(.Rows.Count, "A").End(xlUp))
End With

'Display a common file open dialog to the user to allow
'User to select files to be processed.
maFileName = Application.GetOpenFilename(Title:="Select File(s) to be processed", MultiSelect:=True)
If TypeName(maFileName) = "Boolean" Then
mbErrorSwitch = True
MsgBox Title:="Error", prompt:="No files chosen. Processing will now terminate."
Exit Sub
End If
' Loop through selected files
If IsArray(maFileName) Then
For lngIndex = LBound(maFileName) To UBound(maFileName)
ProcessFile maFileName(lngIndex), rngCopy
Next lngIndex
Else
ProcessFile maFileName, rngCopy
End If

MsgBox prompt:="Your files have been saved"
End Sub
Sub ProcessFile(ByVal strSourceFile As String, rngRangesToProcess As Range)
Dim rngCell As Range
Dim rngSource As Range, rngDest As Range
Dim wksSource As Worksheet, wksDest As Worksheet
Dim shpCopyPic As Shapes
Dim strnewpath As String
Dim lngOffset As Long

' Offset from first copy information column to first destination info column
lngOffset = 4

' Open invoice workbook
Set mwbInvoice = Workbooks.Open(strSourceFile)

' open new template
Set mwbStaticReport = Workbooks.Open(mc_strTEMPLATE_FILE_PATH)



' Get save path
'strNewPath = mc_strSAVE_FILE_PATH & mwbInvoice.Name
strnewpath = lsSavePath & mwbInvoice.Name

' Kill any existing file with the new save name
If Dir(strnewpath) <> "" Then Kill strnewpath

' Copy data across
For Each rngCell In rngRangesToProcess
Set wksSource = mwbInvoice.Worksheets(rngCell.Value)
Set wksDest = mwbStaticReport.Worksheets(rngCell.Offset(0, lngOffset).Value)
Set rngSource = wksSource.Range(rngCell.Offset(0, 2).Value)
Set rngDest = wksDest.Range(rngCell.Offset(0, 2 + lngOffset).Value)
If rngCell.Offset(0, 1).Value = "Cells" Then
rngSource.Copy Destination:=rngDest

End If

Next rngCell



'Copy Pictures
CopyPictures

mwbInvoice.Close False
Set mwbInvoice = Nothing

With mwbStaticReport
.SaveAs Filename:=strnewpath
.Close False
End With
Set mwbStaticReport = Nothing



End Sub







Sub CopyPictures()
'-----------------------------------------------------------------------------------------------
'NAME: RecreateShapeObjects
'DESCRIPTION: This method is used to recreate list objects in a given workbook. Due to the stability and frequent
' corruption issues experienced with list objects, this method should be run when a workbook frequently
' crashes Excel when going to or manipulating a worksheet with a ListObject on it.
'ARGUMENTS: None
'AUTHOR:
'CHANGES:
'----------------------------------------------------------------------------------------------

Dim lwsCurrentSheet As Worksheet
Dim lsShapeName
Dim lshShapes As Shapes
Dim liIdx As Integer
Dim lbSuccess As Boolean
Dim lbPreviousAlerts As Boolean
Dim aryShapeNames()
Dim lrSourceRange As Range
Dim lrPasteRange As Range
Dim lrCopyRange As Range
Dim lshShape As Shape

lbSuccess = True
lbPreviousAlerts = Application.DisplayAlerts

Application.DisplayAlerts = False
Application.Calculation = xlManual
Application.StatusBar = False
Application.ScreenUpdating = False

'Set MovingRange
Set lrCopyRange = ThisWorkbook.Sheets("Sheet1").Range("C639")

Do Until Trim(lrCopyRange.Value) = ""

Set lrSourceRange = mwbInvoice.Sheets(lrCopyRange.Offset(0, 2).Value).Range(lrCopyRange.Value)

For Each lshShape In lrSourceRange.Parent.Shapes

' Debug.Print lshShape.TopLeftCell.Address, lshShape.BottomRightCell.Address
If Not Intersect(lrSourceRange.Areas(1), lshShape.TopLeftCell) Is Nothing Then

'If Not Intersect(lrSourceRange.Areas(A), lshShape.BottomRightCell) Is Nothing Then
If Not Intersect(lrSourceRange.Areas(1), lshShape.BottomRightCell) Is Nothing Then

' the whole chart object is within the export range

If InStr(lshShape.Name, "Picture") > 0 Or InStr(lrCopyRange.Offset(0, 4).Value, "229") > 0 Or lrCopyRange.Offset(0, 4).Value = "B95" Or lrCopyRange.Offset(0, 4).Value = "J95" Then

mwbInvoice.Activate
mwbInvoice.Sheets(lrCopyRange.Offset(0, 2).Value).Activate
lshShape.Copy
mwbStaticReport.Activate
mwbStaticReport.Sheets(lrCopyRange.Offset(0, 2).Value).Activate
Range(lrCopyRange.Offset(0, 4).Value).PasteSpecial Paste:=xlPasteAll

Exit For

End If

End If

End If

Next lshShape

Set lrCopyRange = lrCopyRange.Offset(1, 0)

Loop




End Sub

 

[sanyup2000]

When I run the macro, I want to unprotect the workbook and worksheets automatically , and then protect them again via VBA when the macro has been completely run

 

[sanyup2000]

And i am using Excel 2003

 

[Gavona]

It breaks down on Protect/Unprotect line of code.

I cannot see that code!




Gavin

 

[sanyup2000]

I removed that. So, that its not confusing. But, it was this before the last EndSub at the bottom.

mwbStaticReport.Workbook.Protect Password
mwbStaticReport.Worksheets("Valuation").Protect Password

 

[Gavona]

How about:

mwbStaticReport.Workbook.Protect(Password)
 mwbStaticReport.Worksheets("Valuation").Protect(Password)

rEGARDS

Gavin

 

[sanyup2000]

When I run the macro, I want to unprotect the workbook and worksheets automatically , and then protect them again via VBA when the macro has been completely run????

Let me know.

I tried, this does not work. And with parenthesis, does not work either. This is before last EndSub in the code.


mwbStaticReport.Workbook.UnProtect Password
mwbStaticReport.Worksheets("Valuation").UnProtect Password
mwbStaticReport.Workbook.Protect Password
mwbStaticReport.Worksheets("Valuation").Protect Password

 

[Gavona]

Well using Excel2003 this works for me. I opened a workbook protected the sheet and workbook then can run this macro:

Sub Macro1()
'
password = "1234"
password1 = "12345"
    ActiveSheet.Unprotect (password)
    ActiveWorkbook.Unprotect (password1)
    Range("A1").Value = Range("A1").Value + 1
    ActiveSheet.Protect (password)
    ActiveWorkbook.Protect (password1)
End Sub

Clearly you need to unprotect before you do your stuff and protect after you have done it before you save the workbook.

Gavin

 

[Gavona]

If you cannot get it to work then:
1. confirm that your code works if the workbook and sheet are NOT protected.
2. Post the entire code including the protect, unprotect bits
3. Identify where in the posted code the macro fails and what the error message is. (When it fails note the message and select Debug from the options. The line that is failing will be highlighted.

Gavin

 

[sanyup2000]

Unprotect does not work. My template is readonly, It still pops up asking for a p/w. Can u help ?

 

[sanyup2000]

Here is the code:

Let me know the code to unprotect the read-write of the template.

Thanks

ption Explicit
Const mc_strTEMPLATE_FILE_PATH As String = "C:\Template.xls"
Const Password As String = "Valuation"

Dim mwbMacro As Workbook
Dim mwbAddressesReport As Workbook
Dim mwbLoanActivityReport As Workbook
Dim mwbLoanActivityAdditionalDatesReport As Workbook
Dim maFileName As Variant
Dim mbErrorSwitch As Boolean
Dim miInvoiceCount As Integer
Dim miCounter As Integer
Dim mdStatementDateBegin As Date
Dim mdStatementDateEnd As Date
Dim lsTitle As String
Dim lsFileName As String
Dim lsSavePath As String
Dim lrGSNStartRange As Range
Dim lrAccountsProcessedRange As Range
Dim lrCopyStartRange As Range
Dim lrPasteRange As Range
Dim lrFormulaRange As Range
Dim lrTransactionDetailRange As Range
Dim liBeginningBalance As Double
Dim liEndingBalance As Double
Dim liTransactionCounter As Integer
Dim ldCopyEffectiveDate As Date
Dim ldPasteEffectiveDate As Date
Dim mwbStaticReport As Workbook
Dim mwbInvoice As Workbook





Sub Selectfiletoprocess()
'************************************************************************** ***************
'Name: GetUserInput
'Description:
'Arguments:
'Author:
'Changes:
'************************************************************************** ***************
Dim lngIndex As Long
Dim rngCopy As Range

'Prepare Macro
Set mwbMacro = ThisWorkbook


'Check to ensure User Inputs are in Macro
If mwbMacro.Names("nrSavePath").RefersToRange.Value = "" Then

MsgBox prompt:="Please input Save Path", Title:="Error"
Exit Sub
End If


'Set Save Path
lsSavePath = mwbMacro.Names("nrSavePath").RefersToRange.Value
If Right(lsSavePath, 1) <> "\" Then
lsSavePath = lsSavePath & "\"
End If



With Sheet1
' This will pick all used cells from A13 down.
Set rngCopy = .Range(.Cells(13, "A"), .Cells(.Rows.Count, "A").End(xlUp))
End With

'Display a common file open dialog to the user to allow
'User to select files to be processed.
maFileName = Application.GetOpenFilename(Title:="Select File(s) to be processed", MultiSelect:=True)
If TypeName(maFileName) = "Boolean" Then
mbErrorSwitch = True
MsgBox Title:="Error", prompt:="No files chosen. Processing will now terminate."
Exit Sub
End If
' Loop through selected files
If IsArray(maFileName) Then
For lngIndex = LBound(maFileName) To UBound(maFileName)
ProcessFile maFileName(lngIndex), rngCopy
Next lngIndex
Else
ProcessFile maFileName, rngCopy
End If

MsgBox prompt:="Your files have been saved"
End Sub
Sub ProcessFile(ByVal strSourceFile As String, rngRangesToProcess As Range)
Dim rngCell As Range
Dim rngSource As Range, rngDest As Range
Dim wksSource As Worksheet, wksDest As Worksheet
Dim shpCopyPic As Shapes
Dim strnewpath As String
Dim lngOffset As Long

' Offset from first copy information column to first destination info column
lngOffset = 4

' Open invoice workbook
Set mwbInvoice = Workbooks.Open(strSourceFile)

' open new template

Set mwbStaticReport = Workbooks.Open(mc_strTEMPLATE_FILE_PATH)



' Get save path
'strNewPath = mc_strSAVE_FILE_PATH & mwbInvoice.Name
strnewpath = lsSavePath & mwbInvoice.Name

' Kill any existing file with the new save name
If Dir(strnewpath) <> "" Then Kill strnewpath

' Copy data across
For Each rngCell In rngRangesToProcess
Set wksSource = mwbInvoice.Worksheets(rngCell.Value)
Set wksDest = mwbStaticReport.Worksheets(rngCell.Offset(0, lngOffset).Value)
Set rngSource = wksSource.Range(rngCell.Offset(0, 2).Value)
Set rngDest = wksDest.Range(rngCell.Offset(0, 2 + lngOffset).Value)
If rngCell.Offset(0, 1).Value = "Cells" Then
rngSource.Copy Destination:=rngDest

End If

Next rngCell



'Copy Pictures
CopyPictures

mwbInvoice.Close False
Set mwbInvoice = Nothing

With mwbStaticReport
.SaveAs Filename:=strnewpath
.Close False
End With
Set mwbStaticReport = Nothing



End Sub







Sub CopyPictures()
'-----------------------------------------------------------------------------------------------
'NAME: RecreateShapeObjects
'DESCRIPTION: This method is used to recreate list objects in a given workbook. Due to the stability and frequent
' corruption issues experienced with list objects, this method should be run when a workbook frequently
' crashes Excel when going to or manipulating a worksheet with a ListObject on it.
'ARGUMENTS: None
'AUTHOR:
'CHANGES:
'----------------------------------------------------------------------------------------------

Dim lwsCurrentSheet As Worksheet
Dim lsShapeName
Dim lshShapes As Shapes
Dim liIdx As Integer
Dim lbSuccess As Boolean
Dim lbPreviousAlerts As Boolean
Dim aryShapeNames()
Dim lrSourceRange As Range
Dim lrPasteRange As Range
Dim lrCopyRange As Range
Dim lshShape As Shape

lbSuccess = True
lbPreviousAlerts = Application.DisplayAlerts

Application.DisplayAlerts = False
Application.Calculation = xlManual
Application.StatusBar = False
Application.ScreenUpdating = False

'Set MovingRange
Set lrCopyRange = ThisWorkbook.Sheets("Sheet1").Range("C639")

Do Until Trim(lrCopyRange.Value) = ""

Set lrSourceRange = mwbInvoice.Sheets(lrCopyRange.Offset(0, 2).Value).Range(lrCopyRange.Value)

For Each lshShape In lrSourceRange.Parent.Shapes

' Debug.Print lshShape.TopLeftCell.Address, lshShape.BottomRightCell.Address
If Not Intersect(lrSourceRange.Areas(1), lshShape.TopLeftCell) Is Nothing Then

'If Not Intersect(lrSourceRange.Areas(A), lshShape.BottomRightCell) Is Nothing Then
If Not Intersect(lrSourceRange.Areas(1), lshShape.BottomRightCell) Is Nothing Then

' the whole chart object is within the export range

If InStr(lshShape.Name, "Picture") > 0 Or InStr(lrCopyRange.Offset(0, 4).Value, "229") > 0 Or lrCopyRange.Offset(0, 4).Value = "B95" Or lrCopyRange.Offset(0, 4).Value = "J95" Then

mwbInvoice.Activate
mwbInvoice.Sheets(lrCopyRange.Offset(0, 2).Value).Activate
lshShape.Copy
mwbStaticReport.Activate
mwbStaticReport.Sheets(lrCopyRange.Offset(0, 2).Value).Activate
Range(lrCopyRange.Offset(0, 4).Value).PasteSpecial Paste:=xlPasteAll

Exit For

End If

End If

End If

Next lshShape

Set lrCopyRange = lrCopyRange.Offset(1, 0)

Loop

'Protect and Unprotect Workbook and worksheets.

mwbStaticReport.Protect Password
mwbStaticReport.Worksheets("Valuation").Protect Password


End Sub

 

[WalkerEvans]

Gavona was almost there, but not quite. Since you're using 2003 any code that you put inside the workbook itself will not run until the workbook is already open. You might get around this by putting your code in a universal location such as mymacros.xla, but going that route is a lot of work; it would be much easier just to protect only the worksheets.

What we don't know is:

1) Is there a security issue that makes it mandatory or desirable for most people to be blocked from even viewing the workbook?
2) How were you planning on calling the macro in the first place? How you do that could also have a major impact on security.

Once we have the answers to these two questions we may be in a better position to help.



----------------------------------------------------------------------------------
"A committee is a life form with six or more legs and no brain." -- L. Long

 

[sanyup2000]

1. yes, u r rite.
2. macro is stored externally. They open the macro, Click run in the macro, select the file to process and the file is processed at destinatinon given. the template is saved at C:\. the template is read-write and i dont want them to enter the password. it should be called via macro. thats where i am having problem. once the macro is run, the file processed should again become read-write only.

 

[Gavona]

1. You need to unprotect the workbook or worksheet before you try to make changes to it.

2. You need to protect it again before you save it. I would suggest using the protect & unprotect methods either at the beginning and end of the CopyPictures sub or as I have shown below in your main sub routine. Not clear if your "copy data across" section neeeds the worksheet to be unprotected.

3. In Excel protection refers to the options that you set using Tools,Protection
I now think you are referring to a password set using Files,Save As, Tools,General options. I have assumed that you are using the "password to open" rather than the "password to save". Either way, you need to specify this password when you open the file.

From VBA help:

expression.Open(FileName, UpdateLinks, ReadOnly, Format, Password, WriteResPassword, IgnoreReadOnlyRecommended, Origin, Delimiter, Editable, Notify, Converter, AddToMru, Local, CorruptLoad)

I have changed the name of the variably holding the password - not sure if this is necessary but it could well be a reserved word

' open new template
   
Set mwbStaticReport = Workbooks.Open Filename:=mc_strTEMPLATE_FILE_PATH, Password:=MyPassword
mwbStaticReport.unProtect MyPassword
mwbStaticReport.Worksheets("Valuation").unProtect MyPassword

Do all your stuff including calling CopyPictures

   
mwbInvoice.Close False
Set mwbInvoice = Nothing
   
With mwbStaticReport
    .Protect MyPassword
    .Worksheets("Valuation").Protect MyPassword
    .SaveAs Filename:=strnewpath
    .Close False
End With
Set mwbStaticReport = Nothing

Gavin

 

[WalkerEvans]

Okay, I'm confused; that happens a lot more than I usually like to admit.

According to your reply you need the workbook to be protected so that unauthorized users can't even see it. Yet, the way you have worded your response to my second question makes it appear that anyone at all can access the macro, and thus access the document you didn't want them to see in the first place. If what I believe you are saying is what is actually happening, you really have no security at all! So, how exactly is access to the original macro determined?

In the meantime, the following should solve at least part of your problem. The first bit of code should be the first item in your module:

Private Sub RmvPS
ActiveWorkbook.Unprotect ("Valuation")
ActiveWorkSheets.Unprotect ("Valuation")
Call 'your first routine
End Sub

Then, as the last call in your module, you would use the following:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
ActiveWorkbook.Unprotect ("Valuation")
ActiveWorkSheets.Unprotect ("Valuation")
End Sub

There is a final step that could be included that would beef up security at least a little: when the workbook is closed, set the worksheets Visible property to False.

Worksheets("Whatever").Visible = False
Worksheets("Whichever").Visible = False

You would, of course, have to set the property back to True when the workbook was opened. This way, if folks get into your workbook other than through the macro, they'll think it's just a set of blank sheets.

That's all I can think of until I know how your original macro is accessed.



----------------------------------------------------------------------------------
"A committee is a life form with six or more legs and no brain." -- L. Long