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

Is Workbook Open

   <source lang="vb">

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

</source>
   
  

Protect and share

   <source lang="vb">

Sub ProtectAndShare()

   Dim wb As Workbook
   Set wb = ThisWorkbook
   wb.ProtectSharing "\\public\shared.xls", "pass1", "pass2", , , "pass3"

End Sub

</source>
   
  

Remove sharing

   <source lang="vb">

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

</source>