Solved: Excel 2003/07 - Is it possible to unshare a workbook using code?

[frank_m]

I have two command buttons on a sheet.

The first saves the workbook as a shared. (that works fine)
[vba]Private Sub CommandButton1_Click()
Dim wb As Workbook
Dim fileSaveName As String
Dim InitFileName As String
Dim strDate As String

strDate = Format(Now, "dd-mmm-yy h-mm-ss")

InitFileName = "C:\Users\Owner\Desktop\SharedTest" & Range("I4").Value & "_" & strDate

Set wb = ActiveWorkbook

fileSaveName = Application.GetSaveAsFilename(InitialFileName:=InitFileName, _
filefilter:="Excel files , *.xls")

With wb
If fileSaveName <> "False" Then
.SaveAs fileSaveName, , , , , , xlShared
.KeepChangeHistory = True
.HighlightChangesOptions When:=xlAllChanges
.ListChangesOnNewSheet = True
.HighlightChangesOnScreen = False
.Close False
Else
.Close False
Exit Sub
End If
End With

End Sub[/vba] Using CommandButton2 shown below I was attempting to save it back to not being shared and by a new name. However, the code does not accomplish the un-sharing. It merely saves it as another shared workbook.

Is it possible to unshare a workbook via a preexisting Command button within the shared file?
[vba]Private Sub CommandButton2_Click()
Dim wb As Workbook
Dim fileSaveName As String
Dim InitFileName As String
Dim strDate As String

strDate = Format(Now, "dd-mmm-yy h-mm-ss")

InitFileName = "C:\Users\Owner\Desktop\RemoveSharedTest" & Range("I4").Value & "_" & strDate

Set wb = ActiveWorkbook

fileSaveName = Application.GetSaveAsFilename(InitialFileName:=InitFileName, _
filefilter:="Excel files , *.xls")

With wb
If fileSaveName <> "False" Then
.SaveAs fileSaveName
.Close
Else
.Close False
Exit Sub
End If
End With
End Sub[/vba]

[frank_m]

I got it worked out. Sorry if I took up anyone's time, as I really appreciate all the help I have received here.

I just needed to add these couple commands into my code:
[vba]If wb.MultiUserEditing Then
wb.ExclusiveAccess
End If [/vba] [vba]Private Sub CommandButton2_Click()
Dim wb As Workbook
Dim fileSaveName As String
Dim InitFileName As String
Dim strDate As String

strDate = Format(Now, "dd-mmm-yy h-mm-ss")


InitFileName = "C:\Users\Owner\Desktop\RemoveSharedTest" & Range("I4").Value & "_" & strDate

Set wb = ActiveWorkbook

fileSaveName = Application.GetSaveAsFilename(InitialFileName:=InitFileName, _
filefilter:="Excel files , *.xls")

With wb
If fileSaveName <> "False" Then
.SaveAs fileSaveName
If .MultiUserEditing Then
.ExclusiveAccess
End If
.Close
Else
.Close False
Exit Sub
End If
End With
End Sub[/vba]

[frank_m]

I realized that in my previous code posted, I did not actually want to be closing the workbook after the save as operation, and felt it might be useful to someone to post the new versions.

This saves a regular workbook as a Shared workbook and by a new name.
[vba]Private Sub CommandButton1_Click()
Dim wb As Workbook
Dim fileSaveName As String
Dim InitFileName As String
Dim strDate As String

strDate = Format(Now, "dd-mmm-yy h-mm-ss")

' change the save as path and new name to suit your needs
InitFileName = "C:\Users\Owner\Desktop\SharedTest" & Range("I4").Value & "_" & strDate

Set wb = ActiveWorkbook

fileSaveName = Application.GetSaveAsFilename(InitialFileName:=InitFileName, _
filefilter:="Excel files , *.xls")

With wb
If fileSaveName <> "False" Then
.SaveAs fileSaveName, , , , , , xlShared
.KeepChangeHistory = True
.HighlightChangesOptions When:=xlAllChanges
.ListChangesOnNewSheet = True
.HighlightChangesOnScreen = False
Else
Exit Sub
End If
End With

End Sub[/vba] Below will save a workbook with a new name and remove the shared status.
[vba]Private Sub CommandButton2_Click()
Dim wb As Workbook
Dim fileSaveName As String
Dim InitFileName As String
Dim strDate As String

strDate = Format(Now, "dd-mmm-yy h-mm-ss")

' change the save as path and new name to suit your needs
InitFileName = "C:\Users\Owner\Desktop\RemoveSharedTest" & Range("I4").Value & "_" & strDate

Set wb = ActiveWorkbook

fileSaveName = Application.GetSaveAsFilename(InitialFileName:=InitFileName, _
filefilter:="Excel files , *.xls")

With wb
If fileSaveName <> "False" Then
.SaveAs fileSaveName
If .MultiUserEditing Then
.ExclusiveAccess
End If
Else
Exit Sub
End If
End With[/vba]