Sub GetFile() 
     ' ----------------------------------------------------------------
     ' Procedure Name: GetFile
     ' Purpose: Update Path to VKS Stand Model workbook
     ' Procedure Kind: Sub
     ' Procedure Access: Public
     ' ----------------------------------------------------------------
     
    Dim myObject As Object 
    Dim fileSelected As String 
    Dim myPath As String 
    Dim myFile As String 
    Dim strLen As Integer 
     
    Set myObject = Application.FileDialog(msoFileDialogOpen) 
    myPath = ThisWorkbook.Worksheets("Admin").Range("B7").Value 
    myPath = GetDefaultLocation(myPath) 
     
     ' 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("B7") = myPath 'The file path
        .Range("B10") = myFile 'The file name
    End With 
End Sub 
 
 
Public Function RegKeyRead(i_RegKey As String) As String 
     ' ----------------------------------------------------------------
     ' Procedure Name: RegKeyRead
     ' Purpose: Read registry keys related to OneDrive
     ' Procedure Kind: Function
     ' Procedure Access: Public
     ' Parameter i_RegKey (String): Pass Reg Key to be read
     ' Return Type: String
     ' ----------------------------------------------------------------
     
    Dim myWS As Object 
     
    On Error Resume Next 
     'access Windows scripting
    Set myWS = CreateObject("WScript.Shell") 
     'read key from registry
    RegKeyRead = myWS.RegRead(i_RegKey) 
End Function 
 
Private Function GetLocalPath(docPath As String) As String 
     ' ----------------------------------------------------------------
     ' Procedure Name: GetLocalPath
     ' Purpose: Convert OneDrive URL to local file path
     ' Procedure Kind: Function
     ' Procedure Access: Private
     ' Parameter docPath (String): Pass URL String
     ' Calls: RegKeyRead (ReadRegKeys module)
     ' Return Type: String
     ' ----------------------------------------------------------------
     
    Const strcOneDrivePart As String = "https://d.docs.live.net/" 
    Dim strRetVal As String, bytSlashPos As Byte 
     
    strRetVal = docPath & "" 
    If Left(LCase(docPath), Len(strcOneDrivePart)) = strcOneDrivePart Then 'yep, it's the OneDrive path
         'locate and remove the "remote part"
        bytSlashPos = InStr(Len(strcOneDrivePart) + 1, strRetVal, "/") 
        strRetVal = Mid(docPath, bytSlashPos) 
         'read the "local part" from the registry and concatenate
        strRetVal = RegKeyRead("HKEY_CURRENT_USEREnvironmentOneDrive") & strRetVal 
        strRetVal = Replace(strRetVal, "/", "") 'slashes in the right direction
        strRetVal = Replace(strRetVal, "%20", " ") 'a space is a space once more
    End If 
    GetLocalPath = strRetVal 
     
End Function 
 
Function GetDefaultLocation(ByVal myString As String) As String 
     ' ----------------------------------------------------------------
     ' Procedure Name: GetDefaultLocation
     ' Purpose: Check and return a valid default file location to 'GetPath'
     ' Procedure Kind: Function
     ' Procedure Access: Public
     ' Parameter myString (String): Pass Existing default path for testing
     ' Return Type: String
     ' ----------------------------------------------------------------
     
    Dim folderExists As Boolean 
     
    On Error Resume Next 
    folderExists = (GetAttr(myString) And vbDirectory) = vbDirectory 
    On Error GoTo 0 
     
    If folderExists Then 
        GetDefaultLocation = myString 
    Else 
        GetDefaultLocation = Application.ThisWorkbook.Path 
    End If 
     
End Function