CODEWITHSUNDEEP
sharepoint
Johannes Aronsson
Johannes Aronsson

Reputation: 121

Downloading an excel add in from Sharepoint using VBA

I have an excel file that when opened needs to download and open the latest version of an add in that is stored in Sharepoint. I have this code that downloads the add in, saves it in a specific location (strSavePath) and tries to open it.

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:\WINDOWS\explorer.exe """ & strSavePath & "", vbHide
End Function

However I get an error on the second to last row. The error is: Excel cannot open the file "Filename" because the file format or file extension is not valid [...]". The file downloaded is corrupted and cannot be opened manually either. When I download it and open it manually , it works.

The file size is 30.9 kb, but executing the code will download it as a 51 kb file. I've tried downloading other files using this code, and they have also become corrupted and 51 kb no matter the actual file size. Is there any way to change the code so the file will not be corrupted or any other ways of doing this?

Update: The file downloaded seems to be a html file even though its name still ends with .xlam

Also, I,ve tried using a link that ends with "filename.xlam" and one that ends with "filename.xlam?csf=1&e=b5f7991021ab45c1833229210f3ce810", both gives the same result, and when you copy the links into chrome both immediately downloads the correct file

Upvotes: 1

Views: 805

Answers (2)

Johannes Aronsson
Johannes Aronsson

Reputation: 121

I could not find a way to download to add-ins, tried multiple different way and concluded that there was som authorization error or something else caused by the version of SharePoint I was using. The solution I found that suited my needs was to open the add-ins directly from SharePoint using this code:

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

Upvotes: 0

Moosli
Moosli

Reputation: 3285

I had a once a similar Problem.

The Problem by me was, that sharepoint did not allow a certain kind of file Type. So i had to do a workaround. So what you can try is to Zip your *.xlam File and Put that on the Sharepoint. Then you download it with the Code you already have. And then you just unzipped with the Following Code.

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

And after that you just executed the Extension. I Hope this can help you.

Upvotes: 1

Related Questions