Search code examples
excelvbaoledbconnection

How can multiple users update their copy of an Excel workbook from the source file on a VPN at the same time?


I created a macro-enabled Excel workbook (I'll call it NewData.xlsm) that has a refresh button that when you click it, it connects to the source file in a network folder (Source.xlsm). I shared the NewData.xlsm with my co-workers and they all have a copy of it stored in their computer. I update the source.xlsm file on a monthly basis and my co-workers get the new data by opening their NewData.xlsm file and connecting to Source.xlsm when they click on the refresh button on NewData.xlsm.

The source file is located on a network folder that all the users have access to through VPN.

It works well when everyone tries it individually at different times. The problem happens when:

  • Person #1 opens their copy of NewData.xlsm and updates it without issues and not requiring to enter credentials.
  • Person #2, opens their copy of NewData.xlsm and tries updating it while Person #1 is still using it. Person #2 then gets asked to provide a username and password, but the file doesn't require that. If they provide their Windows credentials, nothing happens and there is no way for them to update the file but until Person #1 closes their NewData.xlsm file.

I want to allow multiple users to connect to the source at the same time without issues. I know that is possible, because I use another Excel (ExcelThatWorks.xlsm), created by someone else, that allows that, but I don't find the way to make my NewData.xlsm to do the same. If I don't achieve that, then the users will have to access the file on a schedule and that is unacceptable.

I did see in the ExcelThatWorks.xlsm file, that there is a code that says OLEDBConnection (I added the code below), and thought that probably that's what I need, but I'm not sure, because I'm using VBA.

I'm using Office LTSC Professional Plus 2021 on Windows 10 Enterprise.

These are all the codes I have on the NewData.xlsm file and it works flawlessly when one person uses it at a time, but not when more than one person opens it simultaneously.

______________________________________
Option Explicit
 
Public Sub Stop_ScreenUpdateOpen()
    Application.ScreenUpdating = False
'Open a workbook
 
  'Open method requires full file path to be referenced.
  Workbooks.Open "\\Full\Shared\Folder\Path\Source.xlsm"
    
    Application.ScreenUpdating = True
End Sub
______________________________________
 
Public Sub Stop_ScreenUpdateCopyPasteRaw()
 
Dim s As Workbook
Dim d As Workbook
Dim vals As Variant
 
 
'## Open both workbooks first:
Set s = Workbooks.Open("\\Full\Shared\Folder\Path\Source.xlsm ")
Set d = ThisWorkbook
 
 
With s.Sheets("RAW").UsedRange
    'Now, paste to d worksheet:
    d.Sheets("RAW").Range("A1").Resize( _
        .Rows.Count, .Columns.Count) = .Value
End With
 
End Sub
 
______________________________________
 
Public Sub Stop_ScreenUpdateCopyPasteData()
 
Dim s As Workbook
Dim d As Workbook
Dim vals As Variant
 
 
'## Open both workbooks first:
Set s = Workbooks.Open("\\Full\Shared\Folder\Path\Source.xlsm ")
Set d = ThisWorkbook
 
 
With s.Sheets("Data").Range("A2:j200")
    'Now, paste to d worksheet:
    d.Sheets("Data").Range("A2").Resize( _
        .Rows.Count, .Columns.Count) = .Value
End With
 
End Sub
______________________________________
 
Public Sub Stop_ScreenUpdateClose()
    Application.ScreenUpdating = False
'Close a workbook
 
  Workbooks("Source.xlsm").Close SaveChanges:=False
    
    Application.ScreenUpdating = True
End Sub
______________________________________
 
Public Sub RefreshConnections()
    ActiveSheet.PivotTables("PivotTable1").RefreshTable
 
    MsgBox "Data has been refreshed!"
 
End Sub
______________________________________
 
CALL Method
 
Public Sub Stop_ScreenUpdateUpdate()
    Application.ScreenUpdating = False
 
Call Stop_ScreenUpdateOpen
 
Call Stop_ScreenUpdateCopyPasteRaw
 
Call Stop_ScreenUpdateCopyPasteData
 
Call Stop_ScreenUpdateClose
 
Call RefreshConnections
 
 
    Application.ScreenUpdating = True
End Sub
______________________________________

The ExcelThatWorks.xlsm file that I mentioned above has this code:

______________________________________
Public Sub UpdatePowerQueries()
' Macro to update my Power Query script(s)
 
Dim lTest As Long, cn As WorkbookConnection
On Error Resume Next
For Each cn In ThisWorkbook.Connections
lTest = InStr(1, cn.OLEDBConnection.Connection, "Provider=Microsoft.Mashup.OleDb.1", vbTextCompare)
If Err.Number <> 0 Then
Err.Clear
Exit For
End If
If lTest > 0 Then cn.Refresh
Next cn
 
End Sub
______________________________________

It has no other code, only that and works like a charm. But I have no idea how to achieve the same result.

I checked Update an excel file by multiple users at same time without opening the file and other threads presented to me before submitting this question but all refer to users editing the source file.

My users are not adding/removing any info from the source file, they are just pulling the new data from the source file, and don't need to edit anything on it.

Adding to this, that when I have the NewData.xlsm file opened and try to open the Source.xlsm file it shows a pop up saying that it is locked for editing and asks to open an Read-Only or click notify.locked for editing by 'another user'

Do you want to connect to Source 001 Clicking Yes, asks for credentials 002 [More cred][4]

Not letting me add more photos but it then says the source file is not found and asks if I want to connect to another source. When I say no, it says that Excel cannot open the connection and cannot refresh.


Solution

  • I want to thank @chris neilsen for his answer. I don't have the option to mark his answer as the resolution, but this is the code that is now working:

      Public Sub CopyData()
        Application.ScreenUpdating = False
    
        Dim filename As String
        filename = "\\full\source\folder\Path\Source.xlsm"
    
        Dim wk As Workbook
        Set wk = Workbooks.Open(filename, ReadOnly:=True)
        ActiveWindow.Visible = False
    
    
        Dim rgSource As Range, rgDestination As Range, s As Workbook
    
    
    'Set a rgSource = [workbook].[worksheet].[range]
    
    
        Set rgSource = wk.Worksheets("RAW").Range("A2:K8000")
        Set rgDestination = ThisWorkbook.Worksheets("RAW").Range("A2")
    
        rgSource.Copy
        rgDestination.PasteSpecial xlPasteValues
    
    
        Set rgSource = wk.Worksheets("Data").Range("A2:j200")
        Set rgDestination = ThisWorkbook.Worksheets("Data").Range("A2")
    
        rgSource.Copy
        rgDestination.PasteSpecial xlPasteValues
    
        Application.DisplayAlerts = False
    
        wk.Close saveChanges:=False
    
        Application.ScreenUpdating = True
    
        End Sub
    
    Public Sub RefreshPivotTables()
        Dim PT As PivotTable
        Dim WS As Worksheet
    
        For Each WS In ThisWorkbook.Worksheets
            If WS.Name <> "PivotTable4" Then
            For Each PT In WS.PivotTables
                PT.RefreshTable
            Next PT
            End If
        Next WS
    
        MsgBox "Data has been refreshed!"
    
    End Sub