将SharePoint模板实例用户名添加至Excel工作簿页脚

问题说明 #

需要将SharePoint上Excel模板生成的实例的创建者用户名（对应SharePoint列表的creator列）添加到工作表页脚，供审计人员打印使用。此前尝试的两段VBA代码均无法满足需求：

• 第一段使用Application.UserName，始终返回模板原作者的用户名，与实例创建者无关
• 第二段使用Environ("Username")，仅返回本地Windows登录账户名，不是SharePoint上记录的实例创建者

现有代码问题分析 #

• Application.UserName：读取的是Excel应用程序的默认用户名（通常是模板创建者的账户），不会随实例创建者变化
• Environ("Username")：读取本地系统的登录账户，无法关联到SharePoint上的文件元数据

解决方案 #

方法1：通过SharePoint REST API获取实例创建者（推荐，适用于审计场景） #

通过调用SharePoint的REST接口，直接获取当前文件在SharePoint中的creator元数据，确保准确性。

Sub GetSharePointCreatorAndSetFooter()
    Dim siteUrl As String
    Dim fileRelativeUrl As String
    Dim xmlHttp As Object
    Dim responseText As String
    Dim creatorName As String
    
    ' 提取当前文件的SharePoint站点URL和相对路径
    siteUrl = Left(ThisWorkbook.FullName, InStrRev(ThisWorkbook.FullName, "/_layouts/") - 1)
    fileRelativeUrl = Mid(ThisWorkbook.FullName, Len(siteUrl) + 2)
    
    ' 发送REST请求获取创建者信息
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
    xmlHttp.Open "GET", siteUrl & "/_api/web/GetFileByServerRelativeUrl('" & fileRelativeUrl & "')/ListItemAllFields?$select=Author/Title&$expand=Author", False
    xmlHttp.setRequestHeader "Accept", "application/json;odata=verbose"
    xmlHttp.send
    
    ' 解析响应提取创建者名称
    responseText = xmlHttp.responseText
    creatorName = Split(Split(responseText, """Title"":""")(1), """")(0)
    
    ' 设置页脚
    With ActiveSheet.PageSetup
        .LeftFooter = "SUBMITTED BY: " & creatorName & " on " & Date
    End With
    
    Set xmlHttp = Nothing
End Sub

注意事项

• 需确保用户拥有当前SharePoint站点的访问权限
• 代码需在文件保存到SharePoint后运行，因为只有保存后才能获取到SharePoint的元数据
• 可将代码绑定到Workbook_BeforeSave事件，实现自动触发：
  在ThisWorkbook模块中添加以下代码：

  Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
      ' 判断是否保存到SharePoint站点
      If InStr(ThisWorkbook.FullName, "sharepoint.com") > 0 Or InStr(ThisWorkbook.FullName, "sharepoint.cn") > 0 Then
          GetSharePointCreatorAndSetFooter
      End If
  End Sub
  

方法2：利用文档内置属性（仅作备选，可靠性有限） #

通过读取Excel文档的内置Author属性，但此属性可能不会自动更新为实例创建者，仅当用户手动修改文档属性时才会变化，不适合严格的审计场景。

Sub SetFooterWithDocumentAuthor()
    Dim creatorName As String
    creatorName = ThisWorkbook.BuiltinDocumentProperties("Author").Value
    
    With ActiveSheet.PageSetup
        .LeftFooter = "SUBMITTED BY: " & creatorName & " on " & Date
    End With
End Sub

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