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:
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.
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