Excel VBA - Find Local File Location of Files on SharePoint

Question

I have a business account that created a SharePoint document folder, of which I've locally synced it to my computers via OneDrive (in D drive, accessible locally).

In VBA of Excel, I know there is a way to call the OneDrive local location by using

environ("OneDrive")

However, I don't know how to specify that in my Excel file in order to locate the local file that's stored on SharePoint.

The reason why this is important is that I need to use VBA to execute mail merge and that I discovered that a SharePoint-stored XLSM cannot be connected properly. Here is the code:

Private Sub InvitationLetter_Click()
Dim WordApp As New Word.Application, ActionFormDocument As Word.Document, WorksheetName As String
Dim OSPFullPath As String: OSPFullPath = ThisWorkbook.FullName

WorksheetName = ActiveWorkbook.Sheets("Guest Speakers").Name

With WordApp
  .DisplayAlerts = wdAlertsNone
  Set ActionFormDocument = .Documents.Open(ThisWorkbook.Path & "\1.2 - Guest Speaker\02 - Guest Speaker Invitation Letter.docx", _
    ConfirmConversions:=False, ReadOnly:=False, AddToRecentfiles:=False)

  With ActionFormDocument
    With .MailMerge
      .MainDocumentType = wdFormLetters
      .SuppressBlankLines = False
      .OpenDataSource Name:=OSPFullPath, ReadOnly:=False, _
        LinkToSource:=True, AddToRecentfiles:=False, _
        Format:=wdOpenFormatAuto, _
        Connection:="Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "User ID=Admin;Data Source=OSPFullPath;" & _
        "Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
        SQLStatement:="SELECT * FROM`" & WorksheetName & "$`" & "WHERE `Status` = 'Pending' And `Nomination Details Alert` LIKE '%Urgent%'", _
        SubType:=wdMergeSubTypeAccess
      .ViewMailMergeFieldCodes = 0
      With .DataSource
        .FirstRecord = wdDefaultFirstRecord
        .LastRecord = wdDefaultLastRecord
      End With
    End With
  End With

  .DisplayAlerts = wdAlertsAll

  .Visible = True
  .Activate
End With

Unload Me
End Sub

I need to point the OSPFullPath locally (e.g. D:\One Drive\Excel.xlsm) instead. I cannot use the 'fullname' function.

Any environ code I can use, or anyway to detect the file location?

A solution for this problem now exists [here](https://stackoverflow.com/a/73577057/12287457). — GWD, Sep 05 '22 at 11:35

score 3 · Answer 1 · answered Sep 23 '19 at 14:53

the following may help if I understand the question correctly, as it gets the full name of a workbook on sharepoint: All credit to answer here 3373470

Private Function Local_Workbook_Name(ByRef wb As Workbook) As String

    Dim i As Long, j As Long
    Dim OneDrivePath As String
    Dim ShortName As String

    'Check if it looks like a OneDrive location
    If InStr(1, wb.FullName, "https://", vbTextCompare) > 0 Then
        'Replace forward slashes with back slashes
        ShortName = Replace(wb.FullName, "/", "\")

        'Remove the first four backslashes
        For i = 1 To 4
            ShortName = Mid(ShortName, InStr(ShortName, "\") + 1)
        Next

        'Loop to see if the tentative LocalWorkbookName is the name of a file that actually exists, if so return the name
        For j = 1 To 3
            OneDrivePath = Environ(Choose(j, "OneDrive", "OneDriveCommercial", "OneDriveConsumer"))
            If Len(OneDrivePath) > 0 Then
                Local_Workbook_Name = OneDrivePath & "\" & ShortName
                If Dir(Local_Workbook_Name) <> "" Then
                    Exit Function
                End If
            End If
        Next j
        'Possibly raise an error here when attempt to convert to a local file name fails - e.g. for "shared with me" files
    End If

    Local_Workbook_Name = wb.FullName

End Function

There is more answers on this thread and links to other pages which may help

Thanks for giving it a go! However, I think the array of environ didn't return the favorable location that I would've wanted. It seemed like Excel doesn't like OneDriveCommercial enough to recognise that as the Sharepoint location. OneDrive and OneDriveCommerical both turned out to point to my 'personal' OneDrive and not my Sharepoint one......which is sad coz I would've thought that's how they classify it! — herman925, Sep 23 '19 at 16:07
I just had a look at my environment variables and they either point to my personal OneDrive or my work OneDrive. None of them point to my synced Sharepoint folders. This is a frustrating problem. — SimpleProgrammer, Apr 24 '20 at 06:21

score 3 · Answer 2 · answered Apr 05 '22 at 14:02

A bit late to the party, but I bumped into the same issue. With some other posts this is my solution, basically looping over the registry (and also finding various OneDrive & SharePoint mounts):

Private Function Local_Workbook_Name(ByRef wb As Workbook) As String
    
    'https://stackoverflow.com/questions/58062253/excel-vba-find-local-file-location-of-files-on-sharepoint
    Dim i As Long, j As Long
    Dim ShortName As String
    Dim TempFile As String
    Dim FolderIndex() As String

    Local_Workbook_Name = ""
    
    'Check if it looks like a OneDrive location
    If InStr(1, wb.FullName, "https://", vbTextCompare) > 0 Then
        'Can be either sharepoint or OneDrive
        'Easiest way to find is to loop through registry
    
        FullName = wb.FullName
        ShortName = FullName
        'Remove the first four slashes
        For i = 1 To 4
            ShortName = Mid(ShortName, InStr(ShortName, "/") + 1)
        Next
        
        PathName = Left(FullName, Len(FullName) - Len(ShortName))
        'Replace slash by backslash
        ShortName = Replace(ShortName, "/", "\")
        
        'Get paths from registry
        GetPaths = GetNamespaceMountPoints()
        For i = LBound(GetPaths, 2) To UBound(GetPaths, 2)
            If PathName = GetPaths(1, i) Then
                'Path okay, check for file
                TempFile = GetPaths(2, i) & "\" & ShortName
                If Dir(TempFile) <> "" Then
                    Local_Workbook_Name = TempFile
                    'File found, OK!
                    Exit For
                End If
            End If
        Next i

        If Local_Workbook_Name = "" Then
            Local_Workbook_Name = wb.FullName
        End If
        'Possibly raise an error here when attempt to convert to a local file name fails - e.g. for "shared with me" files
    Else
        'Document on normal drive like C:\, no need to process
        Local_Workbook_Name = wb.FullName
    End If

End Function
Function GetNamespaceMountPoints() As String()
    'Function to return a 2d array with local path and sharepoint path
    Dim resArr() As String
    Dim strUNS As String, strMP As String
    ReDim resArr(1 To 2, 1 To 1)
    Rw = 1
    
    'Based on: https://stackoverflow.com/questions/18098319/iterate-through-registry-subfolders#18099283
    HKEY_CURRENT_USER = &H80000001
    strComputer = "." ' Use . for current machine
    hDefKey = HKEY_CURRENT_USER
    'Path where all onedrive & sharepoint paths reside
    strKeyPath = "SOFTWARE\SyncEngines\Providers\OneDrive"
    ' Connect to registry provider on target machine with current user
    Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")
    ' Enum the subkeys of the key path we've chosen
    oReg.EnumKey hDefKey, strKeyPath, arrSubKeys
    
    For Each strSubkey In arrSubKeys
        ' Show its value names and types
        strSubKeyPath = strKeyPath & "\" & strSubkey
        oReg.EnumValues hDefKey, strSubKeyPath, arrValueNames, arrTypes
        
        oReg.GetStringValue hDefKey, strSubKeyPath, "UrlNamespace", strUNS
        oReg.GetStringValue hDefKey, strSubKeyPath, "MountPoint", strMP
        
        If strUNS <> "" And strMP <> "" Then
            ReDim Preserve resArr(1 To 2, 1 To Rw)
            resArr(1, Rw) = strUNS
            resArr(2, Rw) = strMP
            Rw = Rw + 1
        End If
    Next
    
    GetNamespaceMountPoints = resArr

End Function

GWD · Answer 3 · 2022-09-05T11:32:12.313

EDIT:

This answer is now outdated and the conclusions from this post are incomplete. Please look at this solution instead!

After reading through and testing countless solutions to this problem in various StackOverflow threads, as well as other online sources, I didn't find a single one that worked for all of my test cases.

I condensed all of the solutions I have seen into this function which seems to finally solve this problem for all cases of OneDrive online paths I have encountered so far... (personal, business, business with SharePoint, synchronized folders from other people's OneDrives, synchronized folders not at the bottom of the online folder structure, etc.):

Public Function GetLocalPath(ByVal Path As String) As String
    Const HKCU = &H80000001
    Dim objReg As Object, rPath As String, subKeys(), subKey
    Dim urlNamespace As String, mountPoint As String, secPart As String
    Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\." & _
                           "\root\default:StdRegProv")
    rPath = "Software\SyncEngines\Providers\OneDrive\"
    objReg.EnumKey HKCU, rPath, subKeys
    For Each subKey In subKeys
        objReg.GetStringValue HKCU, rPath & subKey, "UrlNamespace", urlNamespace
        If InStr(Path, urlNamespace) > 0 Then
            objReg.GetStringValue HKCU, rPath & subKey, "MountPoint", mountPoint
            secPart = Replace(Mid(Path, Len(urlNamespace)), "/", "\")
            Path = mountPoint & secPart
            Do Until Dir(Path, vbDirectory) <> "" Or InStr(2, secPart, "\") = 0
                secPart = Mid(secPart, InStr(2, secPart, "\"))
                Path = mountPoint & secPart
            Loop
            Exit For
        End If
    Next
    GetLocalPath = Path
End Function

Excel VBA - Find Local File Location of Files on SharePoint

3 Answers3

EDIT:

Linked