-
Solved: Excel 2003/07 - Is it possible to unshare a workbook using code?
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]
-
Figure it out
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]
-
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]
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules