Excel VBA Dowload Sharepoint File MSXML2.XMLHTTP.6.0 ResponseBody Error

[mmhill]

I am trying to use VBA to download a file from SharePoint to my local drive. I am having 3 reated problems I cannot figure out ... In the code below, strOBJ can be one of 5 string values.

1. The first 3 cases, the application worked for me but other users consistently get an access error. However, they can access the myURL source file on SharePoint with no issues. If they use case 4 or 5 (MSXML2.server*), they do not get an access error and local files are created. But, on trying to open them, they get an error saying the file extention was wrong or the file was corrupt.
2. While the first 3 cases worked for me, cases 4 and 5 (MSXML2.server*) gave me the same file extention was wrong/file was corrupt error.
3. Mysteriously, after closing and re-opening Excel, on all 5 cases I started getting the same file extention was wrong/file was corrupt error. I am never getting an access error.

This corrupt file issue appears to be a problem with the ResponseBody property but I don't know for sure.

The code below is a test function that takes a myURL$ (full path SharePoint file name), strFileName$ (full path of what I want the local file named) and strOBJ$ (the XMLHTTP object typename).

It first adds an A or B to the strFileName to try 2 methods of downloading the file. The strFileName is 100% guaranteed to be unique and valid. It looks at the file extension as I have tested this with all manner of Office filetypes (e.g., xls*, ppt*, doc*, etc). It then creates the WinHttpReq object, opens it and sends the request. After making sure I get a response, it tries 2 ways (A and B) of creating the local file.

It works for me but not others ... then it quits working for me. I am not a pro at this and I am stumped. Any help is greatly appreciated.

Private Function SaveWebFile(ByVal myURL$, ByVal strFileName$, strOBJ$) As Boolean

    On Error GoTo ErrorHandler

'    strOBJ can be one of the following:
'        Case 1: strOBJ = "Microsoft.XMLHTTP" 'YES
'        Case 2: strOBJ = "MSXML2.XMLHTTP" 'YES
'        Case 3: strOBJ = "MSXML2.XMLHTTP.6.0" 'YES
'        Case 4: strOBJ = "MSXML2.serverXMLHTTP" 'NO
'        Case 5: strOBJ = "MSXML2.ServerXMLHTTP.6.0" 'NO
    Debug.Print strFileName & vbTab & strOBJ
    
    Dim strFileExt$, strTag(1 To 2) As String
    strFileExt = Right(myURL, InStr(1, StrReverse(myURL), ".") - 1)
    strTag(1) = Replace(strFileName, "." & strFileExt, "A." & strFileExt)
    strTag(2) = Replace(strFileName, "." & strFileExt, "B." & strFileExt)

    Dim WinHttpReq As Object
    Set WinHttpReq = CreateObject(strOBJ)
    WinHttpReq.Open "GET", myURL, False ', "user", "password"
    WinHttpReq.send
        
    Do While WinHttpReq.readyState <> 4
        DoEvents
    Loop
    If WinHttpReq.Status <> 200 Then GoTo CleanUp
    
    Dim oStream As Object
    Set oStream = CreateObject("ADODB.Stream")
    With oStream
        .Open
        .Type = 1 'adTypeBinary
        .Write WinHttpReq.responseBody
        .SaveToFile strTag(1), 2 ' 1 = no overwrite, 2 = overwrite
        .Close
    End With
    
    Dim vFF As Long, oResp() As Byte
    oResp = WinHttpReq.responseBody 'Returns the results as a byte array
    vFF = FreeFile
    Open strTag(2) For Binary As #vFF
    Put #vFF, , oResp
    Close #vFF
    
    SaveWebFile = True

ErrorHandler:

    If Err <> 0 Then MsgBox "Fatal Error" & Chr(13) & Err.Description, vbOKOnly + vbCritical, "Error"
    
CleanUp:

    Set WinHttpReq = Nothing
    Set oStream = Nothing

End Function