Excel's fullname property with OneDrive

问题

If I want to use the open Workbook object to get the fullname of an Excel file after saving it, but that file has been synchronized to OneDrive, I get a "https" address instead of a local one, which other programs cannot interpret.
How do I get the local filename of a file like this?

Example:
Save a file to "C:\Users\user\OneDrive - Company\Documents".
OneDrive does its synchronization.
Querying Workbook.FullName now shows as "https://..."

回答1:

It's possible to improve on Virtuoso's answer to reduce (though not eliminate) the chance that the function returns a "wrong" file location. The problem is that there are various URLs that a workbook's .FullName can be. These are three I'm aware of:

1. A URL associated with the user's OneDrive
2. A URL associated with the user's OneDrive for Business
3. A URL associated with somebody else's OneDrive in the case that that other person has "shared" the file (in which case you open the file via File > Open > Shared with me)

On my PC I can get the relevant local folders to map the first two URLs via the OneDriveConsumer and OneDriveCommercial environment variables, that exist in addition to the OneDrive environment variable, so the code below makes use of these. I'm not aware that it's possible to handle the "Shared with Me" files and the code below will return their https://-style location.

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

Unfortunately, if files exist with identical paths within both the OneDrive folder and the OneDrive for Business folder, then the code can't distinguish between them, and may return the "wrong one". I don't have a solution for that.

回答2:

I found a thread online which contained enough information to put something simple together to solve this. I actually implemented the solution in Ruby, but this is the VBA version:

Option Explicit

Private Function Local_Workbook_Name(ByRef wb As Workbook) As String

  Dim Ctr As Long
  Dim objShell As Object
  Dim UserProfilePath 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
    Local_Workbook_Name = Replace(wb.FullName, "/", "\")

    'Get environment path using vbscript
    Set objShell = CreateObject("WScript.Shell")
    UserProfilePath = objShell.ExpandEnvironmentStrings("%UserProfile%")

      'Trim OneDrive designators
    For Ctr = 1 To 4
       Local_Workbook_Name = Mid(Local_Workbook_Name, InStr(Local_Workbook_Name, "\") + 1)
    Next

      'Construct the name
    Local_Workbook_Name = UserProfilePath & "\OneDrive\" & Local_Workbook_Name

  Else

    Local_Workbook_Name = wb.FullName

  End If

End Function

Private Sub testy()

  MsgBox ActiveWorkbook.FullName & vbCrLf & Local_Workbook_Name(ActiveWorkbook)

End Sub

回答3:

Very helpful, thanks. I had a similar issue, but with a folder name rather than a filename. Consequently I modified it slightly. I made it work for folder names AND filenames (doesn't have to be a workbook). In case it's helpful, code is below:

Public Function Local_Name(theName As String) As String
    Dim i               As Integer
    Dim objShell        As Object
    Dim UserProfilePath As String

    ' Check if it looks like a OneDrive location.
    If InStr(1, theName, "https://", vbTextCompare) > 0 Then

        ' Replace forward slashes with back slashes.
        Local_Name = Replace(theName, "/", "\")

        'Get environment path using vbscript.
        Set objShell = CreateObject("WScript.Shell")
        UserProfilePath = objShell.ExpandEnvironmentStrings("%UserProfile%")

        ' Trim OneDrive designators.
        For i = 1 To 4
            Local_Name = Mid(Local_Name, InStr(Local_Name, "\") + 1)
        Next i

        ' Construct the name.
        Local_Name = UserProfilePath & "\OneDrive\" & Local_Name
    Else
        ' (must already be local).
        Local_Name = theName
    End If
End Function

回答4:

I have the same problem as you. But I have solved that problem. The first I turn off OneDrive before I running the script.

you can add this script on the first script into your vba/module:

Call Shell("cmd.exe /S /C" & "%LOCALAPPDATA%\Microsoft\OneDrive\OneDrive.exe /shutdown")

and then, on your last script on your vba/module you can insert this for activate your OneDrive:

Call Shell("cmd.exe /S /C" & "start %LOCALAPPDATA%\Microsoft\OneDrive\OneDrive.exe /background")

I am using Windows10 on that script.

回答5:

Easy Fix (early 2019) - For anyone else having this issue:

OneDrive > Settings > Office: - Uncheck 'Use Office applications to sync Office files that I open'

This lets excel save the file in the typical "C:\Users[UserName]\OneDrive..." file format instead of the UNC "https:\" format.

回答6:

Here's a small improvement on Philip Swannell's improvement of Virtuoso's original answer for when the number of "\" to remove from the path is more than 4 / varies (depending on the file, i found i needed to remove 5 or sometimes 6 of these). The shortcomings mentioned by Philip are still there though.

Private Function Local_Workbook_Name(ByRef wb As Workbook) As String
'returns local wb path or nothing if local path not found
    Dim i As Long
    Dim OneDrivePath As String
    Dim ShortName As String
    Dim testWbkPath As String
    Dim OneDrivePathFound As Boolean

    '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 = RemoveTopFolderFromPath(ShortName)
        Next

        'loop through three OneDrive options
        For i = 1 To 3
            OneDrivePath = Environ(Choose(i, "OneDrive", "OneDriveCommercial", "OneDriveConsumer"))
            If Len(OneDrivePath) > 0 Then
                'Loop to see if the tentative LocalWorkbookName is the name of a file that actually exists, if so return the name
                Do While ShortName Like "*\*"
                    testWbkPath = OneDrivePath & "\" & ShortName
                    If Not (Dir(testWbkPath)) = vbNullString Then
                        OneDrivePathFound = True
                        Exit Do
                    End If
                    'remove top folder in path
                    ShortName = RemoveTopFolderFromPath(ShortName)
                Loop
            End If
            If OneDrivePathFound Then Exit For
        Next i
    Else
        Local_Workbook_Name = wb.FullName
    End If

    If OneDrivePathFound Then Local_Workbook_Name = testWbkPath

End Function
Function RemoveTopFolderFromPath(ByVal ShortName As String) As String
    RemoveTopFolderFromPath = Mid(ShortName, InStr(ShortName, "\") + 1)
End Function

回答7:

I guess there is a little bug in the code of JK2017: The"ShortName"-variable has to be rebuilt at every start of these 3 versions of OneDrive. So ist has to be inside the 'For i = 1 To 3' loop. I have also added the choise to get only the path instead of the full filename.

Private Function Local_Workbook_Name(ByRef wb As Workbook, Optional bPathOnly As Boolean = False) As String
'returns local wb path or nothing if local path not found
Dim i As Long, x As Long
Dim OneDrivePath As String
Dim ShortName As String
Dim testWbkPath As String
Dim OneDrivePathFound As Boolean

'Check if it looks like a OneDrive location
If InStr(1, wb.FullName, "https://", vbTextCompare) > 0 Then

    'loop through three OneDrive options
    For i = 1 To 3
        'Replace forward slashes with back slashes
        ShortName = Replace(wb.FullName, "/", "\")

        'Remove the first four backslashes
        For x = 1 To 4
            ShortName = RemoveTopFolderFromPath(ShortName)
        Next
        'Choose the version of Onedrive
        OneDrivePath = Environ(Choose(i, "OneDrive", "OneDriveCommercial", "OneDriveConsumer"))
        If Len(OneDrivePath) > 0 Then
            'Loop to see if the tentative LocalWorkbookName is the name of a file that actually exists, if so return the name
            Do While ShortName Like "*\*"
                testWbkPath = OneDrivePath & "\" & ShortName
                If Not (Dir(testWbkPath)) = vbNullString Then
                    OneDrivePathFound = True
                    Exit Do
                End If
                'remove top folder in path
                ShortName = RemoveTopFolderFromPath(ShortName)
            Loop
        End If
        If OneDrivePathFound Then Exit For
    Next i
Else
    If bPathOnly Then
        Local_Workbook_Name = RemoveFileNameFromPath(wb.FullName)
    Else
        Local_Workbook_Name = wb.FullName
    End If
End If
If OneDrivePathFound Then
        If bPathOnly Then
        Local_Workbook_Name = RemoveFileNameFromPath(testWbkPath)
    Else
        Local_Workbook_Name = testWbkPath
    End If
End If
End Function

Function RemoveTopFolderFromPath(ByVal ShortName As String) As String
   RemoveTopFolderFromPath = Mid(ShortName, InStr(ShortName, "\") + 1)
End Function

Function RemoveFileNameFromPath(ByVal ShortName As String) As String
   RemoveFileNameFromPath = Mid(ShortName, 1, Len(ShortName) - InStr(StrReverse(ShortName), "\"))
End Function

来源：https://stackoverflow.com/questions/33734706/excels-fullname-property-with-onedrive