从SharePoint站点打开一个Excel文件

Question

我正在尝试使用VBA从SharePoint打开Excel文件。因为每次运行宏时我要查找的文件可能不同，所以我希望能够查看SharePoint文件夹并选择所需的文件。

以下代码可用于在网络驱动器上查找文件，但是当我将其替换为SharePoint地址时，出现“运行时错误76：路径未找到”。

Sub Update_monthly_summary()

Dim SummaryWB As Workbook
Dim SummaryFileName As Variant

ChDir  "http://sharepoint/my/file/path"
SummaryFileName = Application.GetOpenFilename("Excel-files,*.xls", _
1, "Select monthly summary file", , False)
If SummaryFileName = False Then Exit Sub

Set SummaryWB = Workbooks.Open(SummaryFileName)

End Sub

当我将这个地址粘贴到Windows资源管理器中，我可以轻松访问SharePoint文件夹，所以我知道路径是正确的。

为什么VBA不喜欢它呢？

- jayniehaka

---

ChDir()和GetOpenFilename无法在http上工作，但您可以尝试使用SharePoint的“webdav”路径，而不是http路线。 - Tim Williams

您需要使用WebDAV地址来链接文件；Excel会将其视为网络位置。请参见下面的答案，其中包含一个将URL解析为WebDAV地址的函数。 - Shrout1

Answer 1

我使用下面创建的函数将URL转换为WebDAV地址。该函数还可以原样返回常规系统路径和UNC路径。

通过将此函数添加到VBA项目中的模块中，然后在使用文件对话框选择路径之前，在文件对话框命令后输入MyNewPathString = Parse_Resource(myFileDialogStringVariable)来调用此函数。然后在使用目标文件位置时引用"MyNewPathString"。

 Public Function Parse_Resource(URL As String)
 'Uncomment the below line to test locally without calling the function & remove argument above
 'Dim URL As String
 Dim SplitURL() As String
 Dim i As Integer
 Dim WebDAVURI As String


 'Check for a double forward slash in the resource path. This will indicate a URL
 If Not InStr(1, URL, "//", vbBinaryCompare) = 0 Then

     'Split the URL into an array so it can be analyzed & reused
     SplitURL = Split(URL, "/", , vbBinaryCompare)

     'URL has been found so prep the WebDAVURI string
     WebDAVURI = "\\"

     'Check if the URL is secure
     If SplitURL(0) = "https:" Then
         'The code iterates through the array excluding unneeded components of the URL
         For i = 0 To UBound(SplitURL)
             If Not SplitURL(i) = "" Then
                 Select Case i
                     Case 0
                         'Do nothing because we do not need the HTTPS element
                     Case 1
                         'Do nothing because this array slot is empty
                     Case 2
                     'This should be the root URL of the site. Add @ssl to the WebDAVURI
                         WebDAVURI = WebDAVURI & SplitURL(i) & "@ssl"
                     Case Else
                         'Append URI components and build string
                         WebDAVURI = WebDAVURI & "\" & SplitURL(i)
                 End Select
             End If
         Next i

     Else
     'URL is not secure
         For i = 0 To UBound(SplitURL)

            'The code iterates through the array excluding unneeded components of the URL
             If Not SplitURL(i) = "" Then
                 Select Case i
                     Case 0
                         'Do nothing because we do not need the HTTPS element
                     Case 1
                         'Do nothing because this array slot is empty
                         Case 2
                     'This should be the root URL of the site. Does not require an additional slash
                         WebDAVURI = WebDAVURI & SplitURL(i)
                     Case Else
                         'Append URI components and build string
                         WebDAVURI = WebDAVURI & "\" & SplitURL(i)
                 End Select
             End If
         Next i
     End If
  'Set the Parse_Resource value to WebDAVURI
  Parse_Resource = WebDAVURI
 Else
 'There was no double forward slash so return system path as is
     Parse_Resource = URL
 End If


 End Function

此函数将检查您的文件路径是否为URL，以及它是否安全（HTTPS）或不安全（HTTP）。如果是URL，则它将构建适当的WebDAV字符串，以便您可以直接链接到SharePoint中的目标文件。

用户打开文件时可能会提示输入凭据，特别是如果他们不在与您的SharePoint服务器相同的域上。

请注意：我未测试过这个http站点，但我相信它会起作用。

- Shrout1

---

此外，这个答案在Windows XP中不起作用，因为Windows XP不支持WebDAV。所以只适用于Win 7及以上版本。 - Shrout1

我仍然在使用dir(sharepoint)时遇到了runtimeerror 52；文件名或文件号错误。我的文件夹是\\group.sharepoint.com@ssl\sites\ArbeitsVZ\Freigegebene Dokumente。也许与Freigegebene Dokumente中的空格有关？ - Timo

@Timo 可能是这样。还要注意，这个答案现在已经相当老了，很难说 webdav 的默认配置是什么了。如果服务被禁用，这可能是身份验证/访问拒绝错误的结果，但这只是我的猜测。尝试引用您的路径，但确实检查一下是否根本提供了此服务。错误消息可能与实际的根本问题不匹配... - Shrout1

Answer 2

尝试使用此代码从SharePoint网站挑选文件：

Dim SummaryWB As Workbook
Dim vrtSelectedItem As Variant

With Application.FileDialog(msoFileDialogOpen)
    .InitialFileName = "https://sharepoint.com/team/folder" & "\"
    .AllowMultiSelect = False
    .Show
    For Each vrtSelectedItem In .SelectedItems
        Set SummaryWB = Workbooks.Open(vrtSelectedItem)
    Next
End With

If SummaryWB Is Nothing then Exit Sub

如果我记得正确的话，必须启用 Microsoft Scripting Runtime 引用。此外，您的网站可能使用反斜杠，而我的网站使用正斜杠。

- ARich

---

当我运行这段代码时，在.Show处它要求我“打开文件”（打开窗口出现以选择要打开的文件）。这个问题可能出在我的链接上吗？ - Flaw98

@Flaw98 这段代码的目的是打开一个文件对话框（手动选择文件）。如果你想要打开特定的文件而不使用文件对话框，你需要采用不同的方法。 - ARich

嗯，我无法访问我电脑上的SharePoint位置，我想直接从SharePoint地址打开文件，这种方式可行吗？ - Flaw98

教训：这段代码可以选择文件，但没有文件对话框，您需要使用webdav解决方案，请参见下文。 - Timo

Answer 3

在您的脚本中，不要使用http://sharepoint/my/file作为路径，而是使用\\sharepoint\my\file，这样就可以正常工作了。对于我用C#编写的程序，它很有效。

- Jacek

Answer 4

请注意，在您的初始代码中有一个拼写错误。

MyNewPathString = ParseResource(myFileDialogStringVariable)

应该被替换为

MyNewPathString = Parse_Resource(myFileDialogStringVariable)

下划线丢失了。

- Ed van Harmelen

---

谢谢提醒！请记得将评论留在评论区而不是答案区 :) 我已经在我的原始回复中进行了更正。 - Shrout1

Answer 5

你可以使用我的方法将SharePoint文件夹映射为网络驱动器。然后您可以像以前一样继续操作。 Excel VBA从多个SharePoint文件夹上传/下载 然后，您还可以使用Dir或文件系统对象浏览文件。

- psychicebola

---

你应该将你自己的回复粘贴在这里，因为有更多的访客，并删除帖子。 - Timo

Answer 6

虽然这可能不能完全满足OP打开文件对话框的需求，但这是我硬编码打开通过SharePoint/Teams存储的工作簿的方法，它匹配标题并可能是许多人在这里寻找的内容。通过点击“复制链接”获取URL，并剥离位于“ObjectURL”和“baseURL”之间所需的部分。

Sub Test()
Dim URL As String
'Get URL By Coping Link and getting between "ObjectUrl" and "&baseUrl"
'Eg: objectUrl=https%3A%2F%2Fdomain.sharepoint.com%2Fsites%2FName_Teams%2FShared%20Documents%2FGeneral%2FDocuName.xlsx&baseUrl
URL = "https%3A%2F%2Fdomain.sharepoint.com%2Fsites%2FName_Teams%2FShared%20Documents%2FGeneral%2FDocuName.xlsx"
URLDecoded = URLDecode(URL)
'Debug.Print URLDecoded
Set WB = Workbooks.Open(URLDecoded)
End Sub

Public Function URLDecode(StringToDecode As String) As String

Dim TempAns As String
Dim CurChr As Integer

CurChr = 1

Do Until CurChr - 1 = Len(StringToDecode)
  Select Case Mid(StringToDecode, CurChr, 1)
    Case "+"
      TempAns = TempAns & " "
    Case "%"
      TempAns = TempAns & Chr(Val("&h" & _
         Mid(StringToDecode, CurChr + 1, 2)))
       CurChr = CurChr + 2
    Case Else
      TempAns = TempAns & Mid(StringToDecode, CurChr, 1)
  End Select

CurChr = CurChr + 1
Loop

URLDecode = TempAns
End Function

- FreeSoftwareServers

---

我仍然在使用dir(sharepoint)时遇到了runtimeerror 52; filename or filenumber wrong错误。 - Timo

我的网址是 https://group.sharepoint.com/sites/ArbeitsVZ/Freigegebene Dokumente。 - Timo

请始终将空格替换为%20，因此使用以下链接：https://group.sharepoint.com/sites/ArbeitsVZ/Freigegebene%20Dokumente - DeerSpotter

Answer 7

尝试像这样做：

Shell ("C:\Program Files\Internet Explorer\iexplore.exe http://sharepoint/my/file/path")

它对我起作用了。

- Steve

---

欢迎来到SO。我从未听说过一个名为shell的函数。解释“它对我有用”并没有帮助，我不是一只得到食物就会开心的动物。我是一个灵魂伴侣，需要除了“它有效”之外的一些信息。抱歉如此坦率。 - Timo