VBA/Excel/Access/Word/Excel/Workbook Share

Is Workbook Open

 
Sub Main()
   Debug.Print GetDefaultName()
End Sub
Function GetDefaultName() As String
    Dim bGotName As Boolean
    Dim sName As String
    Dim nIndex As Integer
    nIndex = 1
    bGotName = False
    Do
        sName = Left(ThisWorkbook.name, Len(ThisWorkbook.name) - 4) & _
            CStr(nIndex)
        If IsWorkbookOpen(sName & ".xls") Then
            nIndex = nIndex + 1
        Else
            bGotName = True
        End If
    Loop Until bGotName
    GetDefaultName = sName & ".xls"
End Function
Function IsWorkbookOpen(sWorkbookName As String) As Boolean
    Dim myWorkbook As Workbook
    IsWorkbookOpen = False
    For Each myWorkbook In Workbooks
        If StrComp(sWorkbookName, myWorkbook.name, vbTextCompare) = 0 Then
            IsWorkbookOpen = True
            Exit For
        End If
    Next
    Set myWorkbook = Nothing
End Function

Protect and share

 
Sub ProtectAndShare()
    Dim wb As Workbook
    Set wb = ThisWorkbook
    wb.ProtectSharing "\\public\shared.xls", "pass1", "pass2", , , "pass3"
End Sub

Remove sharing

 
Sub RemoveSharing()
    Dim wb As Workbook
    Set wb = Application.Workbooks.Open("\\public\shared.xls", , , , "pass1", "pass2")
    wb.UnprotectSharing pass3
    wb.WritePassword = ""
    wb.Password = ""
End Sub