VBA Auto Save workbook every 10 seconds without activating workbook? - vba

Question

I am using the following vba code in a workbook open event:
Private Sub Workbook_Open()
On Error GoTo Message
Application.AskToUpdateLinks = False
ThisWorkbook.UpdateLinks = xlUpdateLinksNever
ActiveSheet.DisplayPageBreaks = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim currentTime As Date
currentTime = DateAdd("s", 10, Now)
Call CurUserNames
Application.OnTime currentTime, "SaveFile"
Exit Sub
Message:
Application.DisplayAlerts = False
Exit Sub
End Sub
I also have this code in a module:
Public Sub SaveFile()
On Error GoTo Message
ThisWorkbook.Save
Dim currentTime As Date
currentTime = DateAdd("s", 10, Now)
Application.OnTime currentTime, "SaveFile"
Exit Sub
Message:
Application.DisplayAlerts = False
Exit Sub
End Sub
What I am trying to do is automatically save my workbook every 10 seconds.
This works.
However, something quite annoying I've noticed happens. If a user has this workbook open in the background and is working on another excel workbook then this workbook will activate and display on top of the other workbook when saving.
This can be quite annoying for the user.
Is there a way I can get my workbook to save without activating the workbook?
P.S:
For some unknown reason, this also causes the workbook to reopen when its been closed.
EDIT:
List active users in workbook code:
Sub CurUserNames()
Dim str As String
Dim Val1 As String
str = "Users currently online:" & Chr(10)
For i = 1 To UBound(ThisWorkbook.UserStatus)
str = str & ThisWorkbook.UserStatus(i, 1) & ", "
Next
Val1 = DeDupeString(Mid(str, 1, Len(str) - 2))
Worksheets("Delivery Tracking").Range("F4").Value = Val1
End Sub
Function DeDupeString(ByVal sInput As String, Optional ByVal sDelimiter As String = ",") As String
Dim varSection As Variant
Dim sTemp As String
For Each varSection In Split(sInput, sDelimiter)
If InStr(1, sDelimiter & sTemp & sDelimiter, sDelimiter & varSection & sDelimiter, vbTextCompare) = 0 Then
sTemp = sTemp & sDelimiter & varSection
End If
Next varSection
DeDupeString = Mid(sTemp, Len(sDelimiter) + 1)
End Function

Answer 1

Users of a shared workbook can see Who has this workbook open now: just by going to the Review tab in the Ribbon and click the Shared Workbook icon in the Changes group. This will open the Shared Workbook dialog box, in it the tab Editing' shows *Who has this workbook open now:`*. Additionally the tab 'Advance' can be used to update the settings dealing with:
Track changes
Update changes
Conflicting changes between users
Include in personal view

Answer 2

Th9is example comes from How can I get list of users using specific shared workbook?
It is a little overkill. It creates a new workbook to put the users name in. But you can modify it to put the names in whatever sheet and whatever cells you want.
Put it in the sheet module under the selection change module. Then it will update every time the user moves to a different cell. If it is open and he's not at his desk - it doesn't do anything.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub
At the bottom is the code from the above link that you can modify to suit your own needs. It will be 1000 times better than saving a workbook every ten seconds. Which can actually take 3 or 4 seconds itself.
If you don't want to use selection change in the worksheet module then you could put your code into the workbook module Private Sub Workbook_Open()
and put it on a timer to run every 10 seconds. It will only take a fraction of a second instead of several seconds.
users = ActiveWorkbook.UserStatus
With Workbooks.Add.Sheets(1)
For row = 1 To UBound(users, 1)
.Cells(row, 1) = users(row, 1)
.Cells(row, 2) = users(row, 2)
Select Case users(row, 3)
Case 1
.Cells(row, 3).Value = "Exclusive"
Case 2
.Cells(row, 3).Value = "Shared"
End Select
Next
End With