This can be done, but is moderately complex.
here is my code to give you a start, and something to help you search
Private Sub GetFile(sOfficeName As String)
' ----------------------------------------------------------------
' Procedure Name: GetFile
' Purpose: Update input file name and paths
' Parameter sOfficeName (String): pass office name for correct file/location id
' ----------------------------------------------------------------
Dim myObject As Object
Dim fileSelected As String
Dim myPath As String
Dim myFile As String
Dim strLen As Integer
Dim lRow As Integer
Dim mySheet As Worksheet
Call Runfast
Set myObject = Application.FileDialog(msoFileDialogOpen)
Set mySheet = ThisWorkbook.Worksheets("Admin")
lRow = mySheet.Range("B8:B15").Find(sOfficeName).Row
myPath = mySheet.Range("C" & lRow).Value
myPath = GetDefaultLocation(myPath)
myPath = GetLocalPath(myPath)
RedoGetFile:
' Get user file selection
With myObject
.Title = "Choose File"
.InitialFileName = myPath & "\"
.AllowMultiSelect = False
If .Show <> -1 Then
MsgBox ("No File Selected")
Exit Sub
End If
fileSelected = .SelectedItems(1)
End With
'check/convert onedrive path to local file path
fileSelected = GetLocalPath(fileSelected)
'Split into name and path
strLen = Len(fileSelected) - InStrRev(fileSelected, "\")
myFile = Right(fileSelected, strLen)
strLen = Len(fileSelected) - strLen - 1
myPath = Left(fileSelected, strLen)
'Update values
With Worksheets("Admin")
.Range("C" & lRow) = myPath 'The file path
.Range("D" & lRow) = myFile 'The file name
.Range("C" & lRow).Font.ColorIndex = 1
.Range("D" & lRow).Font.ColorIndex = 1
End With
If CheckFileName(myFile, sOfficeName) = False Then GoTo RedoGetFile
Call ResetExcel
End Sub
and
Public Function GetSourceWB(myString As String) As Workbook
'opens the source data WB & returns it as an object
Set GetSourceWB = Workbooks.Open( _
FileName:=myString, _
ReadOnly:=True, _
UpdateLinks:=False)
End Function
My code has various other function calls - ignore these, or use them as prompts for your own management procedures
good luck
Werafa