VBA 帮助 - 通过 VBA 更新 Sharepoint 文件

Question

我正在尝试使用 VBA 更新 sharepoint 文件，本质上这是一个员工将提交给他们的经理的计划，经理单击一个按钮来批准它，这应该更新位于 sharepoint 中的跟踪器。我在下面有我的代码，并指出了我卡在哪里。希望有人能指出我正确的方向！非常感谢。

Sub Approve_By_Manager()

    Dim EmployeeName As String
    
    EmployeeName = Workbooks("L&D Template.xlsm").Worksheets("Sheet1").Range("A3").Value
    
    'Go to sharepoint, open L&D tracker as desktop app THIS IS WHERE I AM STUCK :(
    'The file name from sharepoint is called L&D Tracker.xlsm 
    Dim rng As Range 
    Set rng = Workbooks("L&D Tracker.xlsm").Worksheets("2021-Q1").Range("B4", "B62") 
    For Each Cell In rng
        If Cell.Value = EmployeeName Then 
            Cell.Offset(0, 1).Value = "Y" 
            Cell.Offset(0, 3).Value = "Y" 
        End If
    Next Cell

End Sub

Answer 1

您应该可以使用Workbooks.Open(URLhere) 打开工作簿，更新然后正常保存：

Sub Approve_By_Manager()

    Dim EmployeeName As String, wbMain As Workbook, m, rng As Range
    
    'you can use `ThisWorkbook` to refer to the workbook where your code is running
    EmployeeName = ThisWorkbook.Worksheets("Sheet1").Range("A3").Value
    
    'Go to sharepoint, open L&D tracker as desktop app
    'The file name from sharepoint is called L&D Tracker.xlsm
    Set wbMain = Workbooks.Open("https://contoso.sharepoint.com/Departments/DeptName/Trackers/Main%20Tracker.xlsx")
    Set rng = wbMain.Sheets("Data").Range("B4:B62")
    
    'Match() is faster than looping
    m = Application.Match(EmployeeName, rng, 0)
    If Not IsError(m) Then
        'if m is not an error value then we got a match
        With rng.Cells(m)
            .Offset(0, 1).Value = "Y"
            .Offset(0, 3).Value = "Y"
        End With
    Else
        MsgBox "Employee '" & EmployeeName & "' not found!"
    End If
    
    wbMain.Save
    wbMain.Close
    
End Sub

您可能需要对 URL 进行一些试验 - 您可以使用文件 >> 在 Excel 中打开来尝试您的编辑。
例如，我是从 SharePoint 中的“复制链接”功能获得的

https://contoso.sharepoint.com/:x:/r/Departments/DeptA/App%20Docs/App1/Content%20with%20Dates.xlsx?d=w76f80cf0301743068965e28fea4a1440&csf=1&web=1&e=MxhUda

我编辑的

https://contoso.sharepoint.com/Departments/DeptA/App%20Docs/App1/Content%20with%20Dates.xlsx