如何用GetLocalPath函数在OneDrive环境下为Excel指定单元格填充路径

一、用VBA实现GetLocalPath并填充到命名单元格 #

• 打开Excel，按Alt+F11打开VBA编辑器
• 右键左侧工程窗口的工作簿名称 → 插入 → 模块，新建一个代码模块
• 粘贴以下代码，包含路径转换函数和自动填充命名单元格的逻辑：

' 转换OneDrive/SharePoint在线路径为本地文件路径
Function GetLocalPath(FullPath As String) As String
    Dim strDrive As String, strPath As String
    Dim objWSHShell As Object, objFSO As Object
    
    Set objWSHShell = CreateObject("WScript.Shell")
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    ' 处理OneDrive个人版路径
    If InStr(FullPath, "https://d.docs.live.net/") > 0 Then
        strDrive = objWSHShell.RegRead("HKCU\Software\Microsoft\OneDrive\Accounts\Personal\UserFolder")
        strPath = Replace(FullPath, "https://d.docs.live.net/" & Mid(FullPath, InStr(FullPath, "/") + 1, InStr(InStr(FullPath, "/") + 1, FullPath, "/") - InStr(FullPath, "/") - 1), "")
        strPath = Replace(strPath, "/", "\")
        GetLocalPath = objFSO.BuildPath(strDrive, strPath)
    ' 处理OneDrive商业版/SharePoint路径
    ElseIf InStr(FullPath, "https://") > 0 And (InStr(FullPath, "-my.sharepoint.com/") > 0 Or InStr(FullPath, ".sharepoint.com/sites/") > 0) Then
        strDrive = objWSHShell.RegRead("HKCU\Software\Microsoft\Office\16.0\Common\Internet\WebCache\SharePointCache\")
        strPath = Replace(FullPath, "/", "\")
        strPath = Replace(strPath, "https:", "")
        GetLocalPath = objFSO.BuildPath(strDrive, strPath)
    Else
        ' 非OneDrive路径直接返回原路径
        GetLocalPath = FullPath
    End If
    
    Set objWSHShell = Nothing
    Set objFSO = Nothing
End Function

' 工作簿打开时自动更新命名单元格的路径
Sub UpdateDynamicPath()
    Dim localPath As String
    Dim targetCell As Range
    
    ' 提取当前工作簿的本地文件夹路径（不含文件名）
    localPath = Left(GetLocalPath(ThisWorkbook.FullName), InStrRev(GetLocalPath(ThisWorkbook.FullName), "\"))
    
    ' 定位或创建名为"DynamicCSVPath"的命名单元格
    On Error Resume Next
    Set targetCell = ThisWorkbook.Names("DynamicCSVPath").RefersToRange
    On Error GoTo 0
    
    If targetCell Is Nothing Then
        ' 示例：在Sheet1的A1单元格创建命名范围，可根据需求修改位置
        Set targetCell = ThisWorkbook.Sheets("Sheet1").Range("A1")
        ThisWorkbook.Names.Add Name:="DynamicCSVPath", RefersTo:=targetCell
    End If
    
    ' 将本地路径写入命名单元格
    targetCell.Value = localPath
End Sub

• 设置工作簿打开自动运行宏：右键左侧工程窗口的ThisWorkbook → 查看代码 → 在代码窗口上方的下拉菜单选择Workbook，再选择Open事件，粘贴以下代码：

Private Sub Workbook_Open()
    UpdateDynamicPath
End Sub

• 保存工作簿为「启用宏的工作簿」（.xlsm格式），确保同事打开时宏能正常运行。
• 修改Power Query数据源：编辑现有查询，将硬编码路径替换为=Excel.CurrentWorkbook(){[Name="DynamicCSVPath"]}[Content]{0}[Column1]，再与文件名拼接即可实现动态加载。

二、解决Excel无「用户自定义」函数类别的问题 #

• 无需依赖「插入函数」的用户自定义类别，直接在单元格中手动输入自定义函数名即可（比如=GetLocalPath(ThisWorkbook.FullName)），这是最直接的方式。
• 若希望自定义函数出现在「插入函数」列表中，可在VBA函数上方添加注释标记（仅支持部分Excel版本）：

'@FunctionDescription("将OneDrive/SharePoint在线路径转换为本地文件路径")
'@Category("自定义工具")
Function GetLocalPath(FullPath As String) As String
    ' 函数代码...
End Function

内容的提问来源于stack exchange，提问作者Will Shattuck