请求编写Excel宏：基于列内容在SharePoint创建主文件夹及子文件夹

问题根源 #

1. 路径定位错误：现有代码未读取Excel文件所在的SharePoint实际路径，默认指向站点根目录的Documents库
2. 子文件夹关联失败：未正确拼接主文件夹与子文件夹的路径，或缺少文件夹存在性判断导致创建逻辑异常

可运行的VBA代码 #

Sub CreateSPHierarchyFolders()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim mainFolder As String, subFolder As String
    Dim spBasePath As String, mainPath As String, subPath As String
    
    ' 指定数据所在工作表（自行修改为你的表名）
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' 获取当前Excel文件所在的SharePoint根路径
    spBasePath = Left(ThisWorkbook.FullName, Len(ThisWorkbook.FullName) - Len("/" & ThisWorkbook.Name))
    
    ' 获取F列最后一行数据（假设表头在第1行）
    lastRow = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row
    
    ' 遍历每一行数据
    For i = 2 To lastRow
        mainFolder = Trim(ws.Cells(i, "F").Value)
        subFolder = Trim(ws.Cells(i, "D").Value)
        
        ' 跳过空内容行
        If mainFolder <> "" And subFolder <> "" Then
            mainPath = spBasePath & "/" & mainFolder
            subPath = mainPath & "/" & subFolder
            
            ' 创建主文件夹（不存在则创建）
            If Not IsSPFolderExist(mainPath) Then
                MakeSPFolder mainPath
            End If
            
            ' 创建子文件夹（不存在则创建）
            If Not IsSPFolderExist(subPath) Then
                MakeSPFolder subPath
            End If
        End If
    Next i
    
    MsgBox "层级文件夹创建完成", vbOKOnly + vbInformation
End Sub

' 检查SharePoint文件夹是否存在
Function IsSPFolderExist(folderUrl As String) As Boolean
    Dim httpObj As Object
    Set httpObj = CreateObject("MSXML2.XMLHTTP.6.0")
    
    On Error Resume Next
    httpObj.Open "HEAD", folderUrl, False
    httpObj.Send
    IsSPFolderExist = (httpObj.Status = 200)
    On Error GoTo 0
    
    Set httpObj = Nothing
End Function

' 创建SharePoint文件夹
Sub MakeSPFolder(folderUrl As String)
    Dim httpObj As Object
    Set httpObj = CreateObject("MSXML2.XMLHTTP.6.0")
    
    httpObj.Open "MKCOL", folderUrl, False
    httpObj.Send
    
    Set httpObj = Nothing
End Sub

关键细节说明 #

• 路径精准定位：通过截取Excel文件的完整路径，直接获取其所在的SharePoint目录，确保文件夹和Excel同路径
• 空值过滤：用Trim清除单元格空格，避免因空格导致的无效文件夹名
• 容错处理：创建前先检查文件夹是否存在，避免重复创建引发的权限或路径错误
• REST API兼容性：使用标准的MKCOL方法创建文件夹，适配SharePoint Online及2016+版本

使用提示 #

1. 必须先将Excel文件保存到SharePoint站点，否则无法获取正确的基础路径
2. 替换代码中的Sheet1为你的实际工作表名称
3. 确保当前登录账号拥有目标SharePoint路径的写入权限
4. 旧版SharePoint（2013及更早）可能需要调整API请求头，可根据站点文档修改

内容的提问来源于stack exchange，提问作者Jorge Cárdenas González