ProtectSharing Method

I'm still searching for a solution to this. If it is an Excel Bug, am I out of luck? (other than upgrading to 2000 which there is no way this company would do right now because we just had layoffs)

Thanks for any help!

Interesting!

I am running Excel 97 SR2.

Thanks!

DDD,
You didn't mention if you knew the password to the workbooks when you tried to run this macro. I'm assuming that you do. This code works good for me. If the workbook is not already protected then leave the first inputbox blank. If you don't want it protected and it is, leave the second input box blank. If you have any ?'s let me know. Let me know how it works!
Ryan

Sub ProtectAndShare()
Dim OldPass As Variant
Dim NewPass As Variant
Dim CurFilename As String
Dim CurPath As String
Dim CurFile As String

CurPath = ActiveWorkbook.Path
CurFilename = ActiveWorkbook.Name
CurFile = CurPath & "\" & CurFilename

Application.ScreenUpdating = False
Application.DisplayAlerts = False

OldPass = InputBox("Please enter old password", "Old Password")
NewPass = InputBox("Please enter new password", "New Password")

If MsgBox("This will replace your old password with a new one", vbOKCancel, "Continue") _
= vbCancel Then Exit Sub

ActiveWorkbook.UnprotectSharing (OldPass)
If NewPass <> "" Then ActiveWorkbook.ProtectSharing FileName:=CurFile, Sharingpassword:=NewPass

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Thanks so much for responding!

If I understand your code correctly, it is changing the sharing password on the file. I guess I wasn't completely clear on my first message. I know the sharing password. And I want it to remain the same.

What I am trying to do is create a macro that the user can execute using a keyboard shortcut (CTRL-SHIFT-H) that hides (or unhides - CTRL-SHIFT-U) 2 columns on 6 worksheets in a password protected workbook (Tools/protection/protect workbook - give password) and that is then protected and shared (Tools/protection/shared and protect workbook - give password). So the macro needs to unshare the workbook, hide the columns, and then reshare the workbook.

My problem occurs when the workbook is protected (tools/protection/protect workbook-password), the code to unshare, hide columns, then reshare doesn't work. I get an error code 5 on the line that says 'ActiveWorkbook.protectsharing Filename:=curfile, sharingpassword:="2Chg"'. If I remove the argument 'sharingpassword' it works fine. It's like it won't let me set a sharing password if the workbook is already protected. But if the workbook is not protected, then the code runs fine. I don't get the error code 5 when I use the 'sharingpassword' argument.

I need the workbook to be protected because I don't want the users to be able to change the order of the sheets in the workbook. Make sense at all?

If you manually do the steps in Excel like this it works fine (with the workbook protected). Tools/protection/protect and share workbook - password.

But in the code I have, it's almost like it's doing these steps instead. Tools / share workbook / Allow changes by more than one user. And then tools/ protection / protect shared workbook - which will not allow a password.

Sorry to go into so much detail. I'm just really confused and maybe I am using the wrong words to describe the problem (which is why I added the menu bar steps in parantheses).

Thanks for looking at this!

Here's the code
===============================

Option Explicit
Option Base 1 ' array subscripts start at 1 instead of 0
Dim AllowUnshare As Boolean

Sub ShareandProtect()

Dim CurFilename As String
Dim CurPath As String
Dim CurFile As Variant
Dim shPassword As Variant

CurPath = ActiveWorkbook.Path
CurFilename = ActiveWorkbook.Name
CurFile = CurPath + "\" + CurFilename
shPassword = "2Chg"

Application.DisplayAlerts = False
ActiveWorkbook.ProtectSharing FileName:=CurFile, sharingpassword:="2Chg"
Application.DisplayAlerts = True

End Sub

Sub UnShareandUnProtect()

'declaration
Dim muePrompt As String
Dim mueTitle As String
Dim users As Variant

'set values
muePrompt = "There are other users currently accessing this file. " & _
vbNewLine & vbNewLine & _
"Removing this file from shared use will result in the other users " & _
"losing their work." & _
vbNewLine & vbNewLine & _
"Please ask the other users to exit the file and " & _
"try to run this macro again." & vbNewLine & vbNewLine & _
"MACRO CANCELLED"
mueTitle = "FILE IN USE BY OTHER USERS"
users = ActiveWorkbook.UserStatus()
AllowUnshare = True

'Are other users in the shared workbook?
If UBound(users, 1) > 1 Then

'if there are other users then cancel macro
MsgBox Prompt:=muePrompt, Buttons:=vbOKOnly, Title:=mueTitle
AllowUnshare = False
Else
'if there are not any other users then remove the workbook from shared use
Application.DisplayAlerts = False
ActiveWorkbook.UnprotectSharing ("2Chg")
Application.DisplayAlerts = True

End If

End Sub

Sub HideColumns()

'makes sure this code is only run this workbook
If ActiveWorkbook.Name <> ThisWorkbook.Name Then Exit Sub

Dim xnum As Integer ' Holds number of sheets in workbook
Dim sheetplacemark As String
Dim cellplacemark As Variant
Dim I As Integer

UnShareandUnProtect

If AllowUnshare = False Then
Exit Sub
End If

Application.ScreenUpdating = False

xnum = ActiveWorkbook.Sheets.Count
sheetplacemark = ActiveSheet.Name
cellplacemark = Application.activecell.Address

For I = 1 To xnum
ActiveWorkbook.Sheets(I).Select
ActiveSheet.Unprotect Password:="xxx"
Range("p:p,r:r").Select
Selection.EntireColumn.Hidden = True
ActiveSheet.Protect Password:="xxx"
Range("c10").Select
Next I

ActiveWorkbook.Sheets(sheetplacemark).Select
Range(cellplacemark).Select

Application.ScreenUpdating = True

ShareandProtect

End Sub

Sub UnhideColumns()
'makes sure this code is only run this workbook
If ActiveWorkbook.Name <> ThisWorkbook.Name Then Exit Sub

Dim xnum As Integer ' Holds number of sheets in workbook
Dim sheetplacemark As String
Dim cellplacemark As Variant
Dim I As Integer

UnShareandUnProtect

If AllowUnshare = False Then
Exit Sub
End If

Application.ScreenUpdating = False

xnum = ActiveWorkbook.Sheets.Count
sheetplacemark = ActiveSheet.Name
cellplacemark = Application.activecell.Address

For I = 1 To xnum
ActiveWorkbook.Sheets(I).Select
ActiveSheet.Unprotect Password:="xxx"
Range("p:p,r:r").Select
Selection.EntireColumn.Hidden = False
ActiveSheet.Protect Password:="xxx"
Range("c10").Select
Next I

ActiveWorkbook.Sheets(sheetplacemark).Select
Range(cellplacemark).Select

Application.ScreenUpdating = True

ShareandProtect

End Sub

Hey,
What version of Excel are you using. I'm using XL2000, and I copied your code, and what do you know, it worked fine. So i'm guessing you're using XL97, and it's got a little bug. Let me know what version, and we'll go from there.

Ryan