使用VBA从Sharepoint下载excel

Posted 2021-05-06

我有一个excel文件，打开时需要下载并打开存储在Sharepoint中的最新版本的添加。我有这个代码下载添加，将其保存在特定位置（strSavePath）并尝试打开它。

Function funLoadRomeFiles(strURL As String, strSavePath As String)

Dim objConnection As Object
Dim objStream As Object

    Set objConnection = CreateObject("MSXML2.ServerXMLHTTP.6.0")

    On Error GoTo ExitConnect
    objConnection.Open "GET", strURL, False
    objConnection.send
    strURL = objConnection.responseBody
    If objConnection.Status = 200 Then
        Set objStream = CreateObject("ADODB.Stream")
        objStream.Open
        objStream.Type = 1
        objStream.Write objConnection.responseBody
        objStream.SaveToFile strSavePath, 2
        objStream.Close
    End If
ExitConnect:
    On Error GoTo 0
    Shell "C:WINDOWSexplorer.exe """ & strSavePath & "", vbHide
End Function

但是我在倒数第二行遇到错误。错误是：Excel无法打开文件“文件名”，因为文件格式或文件扩展名无效[...]“。下载的文件已损坏，无法手动打开。当我下载并手动打开时，有用。

文件大小为30.9 kb，但执行代码会将其下载为51 kb文件。我尝试使用此代码下载其他文件，它们也已损坏，无论实际文件大小为51 kb。有没有办法更改代码，以便文件不会被破坏或任何其他方式这样做？

更新：下载的文件似乎是一个html文件，即使它的名称仍以.xlam结尾

另外，我尝试使用以“filename.xlam”结尾的链接和以“filename.xlam？csf = 1＆e = b5f7991021ab45c1833229210f3ce810”结尾的链接，两者都给出了相同的结果，并且当您将链接立即复制到chrome时下载正确的文件

答案

我有一个类似的问题。

我的问题是，该sharepoint不允许某种文件类型。所以我不得不做一个解决方法。所以你可以尝试将你的* .xlam文件压缩并将其放在Sharepoint上。然后使用您已有的代码下载它。然后你只需解压缩以下代码。

Sub Unzip1()
    Dim FSO As Object
    Dim oApp As Object
    Dim Fname As Variant
    Dim FileNameFolder As Variant
    Dim DefPath As String
    Dim strDate As String

    Fname = strSavePath' I assume that this is the Path to the File you Downloaded
    If Fname = False Then
        'Do nothing
    Else
        'Root folder for the new folder.

        DefPath = Application.DefaultFilePath 'Or Change it to the Path you want to unzip the Files
        If Right(DefPath, 1) <> "" Then
            DefPath = DefPath & ""
        End If

        'Create the folder name
        strDate = Format(Now, " dd-mm-yy h-mm-ss")
        FileNameFolder = DefPath & "MyUnzipFolder " & strDate & ""

        'Make the normal folder in DefPath
        MkDir FileNameFolder

        'Extract the files into the newly created folder
        Set oApp = CreateObject("Shell.Application")

        oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items

        'If you want to extract only one file you can use this:
        'oApp.Namespace(FileNameFolder).CopyHere _
         'oApp.Namespace(Fname).items.Item("test.txt")

        MsgBox "You find the files here: " & FileNameFolder

        On Error Resume Next
        Set FSO = CreateObject("scripting.filesystemobject")
        FSO.deletefolder Environ("Temp") & "Temporary Directory*", True
    End If
End Sub

之后你刚刚执行了扩展。我希望这可以帮到你。

另一答案

我找不到下载到加载项的方法，尝试了多种不同的方式，并得出结论是有som授权错误或由我正在使用的SharePoint版本引起的其他问题。我发现符合我需求的解决方案是使用以下代码直接从SharePoint打开加载项：

On Error Resume Next
ActiveWorkbook.FollowHyperlink Address:="strUrl"
On Error GoTo 0