' XLSCO Check-Out Macros for Excel ' (c) 2013, Our Community News, Inc., All Rights Reserved ' ' These Visual Basic for Applications (VBA) macros are intended to help users who access shared spreadsheets in Dropbox avoid "conflicted copies." ' A variant might be usable with other synchronization products such as Google Drive, Sugar Sync, or Box.com. ' A spreadsheet is checked-out to a person by recording their UserName in the spreadsheet's "Manager" built-in property. ' The "Manager" built-in property is set empty when the spreadsheet is closed (i.e., checked-in). ' Check-out and check-in only applies to spreadsheets stored in Dropbox. ' ' Use them at your own risk. Provided as-is with no explicit or implicit warranty of fitness for any purpose. ' ' System Requirements: Office 2010 on a PC or Office 2011 on a Mac. ' Might work on earlier versions of Office on PCs. Office 2008 for the Mac does not support VBA. ' ' Install by using the VBA editor to copy the entire text into ThisWorkbook Excel Object in the spreadsheets you want to share. ' ' Versions: ' 1.0 January 20, 2013 (John Heiser) ' Initial Release ' 2.0 February 2, 2013 (John Heiser) ' Added bypass in the event the spreadsheet was opened in protected mode (e.g., from an email attachment). ' Added capture and checking of computer name in the "Company" built-in worksheet property. ' Added capture at check-out of date and time in the "Comments" built-in worksheet property. ' Added capture at check-in of check-out/check-in info in "Comments" with display with check-out question. ' Private Function ComputerName() As String ' Return computer name If Not Application.OperatingSystem Like "*Mac*" Then ComputerName = Environ$("computername") ' Running on Windows Else ComputerName = "Mac" ' Running on a Mac. For now, supply default name End If End Function Private Sub Workbook_Open() ' Spreadsheet has been opened On Error GoTo Bypass ' Bypass if spreadsheet opened in protected mode (e.g., from an email attachment) If InStr(UCase(ActiveWorkbook.Path), "DROPBOX") > 0 Then ' Make sure the spreadsheet is in Dropbox If ActiveWorkbook.BuiltinDocumentProperties("Manager") = "" Then ' If not checked-out If MsgBox("Do you want to check-out """ & ActiveWorkbook.Name & """?" & vbNewLine & vbNewLine & _ ActiveWorkbook.BuiltinDocumentProperties("Comments"), vbYesNo + vbQuestion) = vbYes Then ' Ask about check-out ActiveWorkbook.BuiltinDocumentProperties("Manager") = Application.UserName ' Set Manager name to check it out ActiveWorkbook.BuiltinDocumentProperties("Comments") = "checked-out " & Now ' Save the date and time ActiveWorkbook.BuiltinDocumentProperties("Company") = ComputerName ' Save the computer name ActiveWorkbook.Save ' Save the file so it will be synched Else MsgBox "When you are done viewing it, please close this spreadsheet without saving changes.", vbInformation End If Else If ActiveWorkbook.BuiltinDocumentProperties("Manager") <> Application.UserName Or _ ActiveWorkbook.BuiltinDocumentProperties("Company") <> ComputerName Then ' If checked-out to someone else or to this user on other computer MsgBox "This spreadsheet is being edited by " & ActiveWorkbook.BuiltinDocumentProperties("Manager") & " (" & _ ActiveWorkbook.BuiltinDocumentProperties("Company") & ")." & vbNewLine & _ "It was " & ActiveWorkbook.BuiltinDocumentProperties("Comments") & "." & vbNewLine & _ "When you are done viewing it, please close this spreadsheet without saving changes.", vbExclamation Else MsgBox "This spreadsheet is checked-out to you." & vbNewLine & _ "It was " & ActiveWorkbook.BuiltinDocumentProperties("Comments") & "." & vbNewLine & _ "To check it in, save changes when you close.", vbInformation End If End If End If Bypass: End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) ' Spreadsheet is about to be saved If InStr(UCase(ActiveWorkbook.Path), "DROPBOX") > 0 Then ' Make sure the spreadsheet is in Dropbox If ActiveWorkbook.BuiltinDocumentProperties("Manager") <> "" Then ' If checked-out If ActiveWorkbook.BuiltinDocumentProperties("Manager") <> Application.UserName Or _ ActiveWorkbook.BuiltinDocumentProperties("Company") <> ComputerName Then ' To someone else or to this person on other computer MsgBox "Changes have not been saved. This spreadsheet is being edited by " & ActiveWorkbook.BuiltinDocumentProperties("Manager") & " (" & _ ActiveWorkbook.BuiltinDocumentProperties("Company") & ")." & vbNewLine & _ "It was " & ActiveWorkbook.BuiltinDocumentProperties("Comments") & ".", vbExclamation Cancel = True ' Abort the spreadsheet save Else ' Checked out to this user If SaveAsUI Then ' If File-Save-As, display warning that original file will remain checked-out MsgBox "If this spreadsheet is saved as a different file, """ & ActiveWorkbook.Name & """ will remain checked-out to you." & vbNewLine & _ "To check it in, please reopen it and save changes when you close.", vbInformation End If End If End If End If End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) ' Spreadsheet is about to be closed If InStr(UCase(ActiveWorkbook.Path), "DROPBOX") > 0 Then ' Make sure the spreadsheet is in Dropbox If ActiveWorkbook.BuiltinDocumentProperties("Manager") = Application.UserName And _ ActiveWorkbook.BuiltinDocumentProperties("Company") = ComputerName Then ' If checked-out to this user on this computer If ActiveWorkbook.Saved = False Then ' If changes were made If MsgBox("Do you want to save the changes you made to """ & ActiveWorkbook.Name & """?", vbYesNo + vbQuestion) = vbNo Then ' Want to discard the changes? MsgBox "Changes will not be saved but this spreadsheet will still be checked-out to you." & vbNewLine & _ "To check it in, please reopen it and save changes when you close.", vbInformation ActiveWorkbook.Saved = True ' Make sure it isn't saved Else ' OK to save changes ActiveWorkbook.BuiltinDocumentProperties("Manager") = "" ' Check it in and save check-out/check-in info ActiveWorkbook.BuiltinDocumentProperties("Comments") = "Last " & ActiveWorkbook.BuiltinDocumentProperties("Comments") & _ " by " & Application.UserName & " (" & ActiveWorkbook.BuiltinDocumentProperties("Company") & ")." & vbNewLine & _ "Checked-in " & Now & "." ActiveWorkbook.BuiltinDocumentProperties("Company") = "" ActiveWorkbook.Save ' Save the file so it will be synched End If Else ' No changes made ActiveWorkbook.BuiltinDocumentProperties("Manager") = "" ' Check it in and save check-out/check-in info ActiveWorkbook.BuiltinDocumentProperties("Comments") = "Last " & ActiveWorkbook.BuiltinDocumentProperties("Comments") & _ " by " & Application.UserName & " (" & ActiveWorkbook.BuiltinDocumentProperties("Company") & ")." & vbNewLine & _ "Checked-in " & Now & "." ActiveWorkbook.BuiltinDocumentProperties("Company") = "" ActiveWorkbook.Save ' Save the file so it will be synched End If Else ' It is not checked-out to this user on this computer If ActiveWorkbook.BuiltinDocumentProperties("Manager") = "" Then ' If not checked-out, give a generic warning MsgBox "Please close this spreadsheet without saving changes.", vbExclamation Else ' Checked out to different person or on different computer. Give specific warning. MsgBox "This spreadsheet is being edited by " & ActiveWorkbook.BuiltinDocumentProperties("Manager") & " (" & _ ActiveWorkbook.BuiltinDocumentProperties("Company") & ")." & vbNewLine & _ "It was " & ActiveWorkbook.BuiltinDocumentProperties("Comments") & "." & vbNewLine & _ "Please close this spreadsheet without saving changes.", vbExclamation End If End If End If End Sub