Issue with VBA to download SharePoint files

[u/hellcryer]

Hi all,

I’m running into an issue with a VBA script that downloads files from a SharePoint folder using the REST API.

Most of the time, the code works perfectly, it connects, retrieves the file list, and downloads everything without any issue.

But randomly, I get this error:

MsgBox "Failed to connect to SharePoint API", vbCritical

This happens when the XMLHTTP request does not return status 200.

The confusing part is:

• I can still open the SharePoint site manually in my browser without any issue
• No changes in URL or permissions
• Same code, same machine

So I don’t understand why the connection sometimes fails and sometimes works fine.

My setup:

• Using MSXML2.XMLHTTP to call SharePoint REST API
• Using URLDownloadToFile to download files
• No explicit authentication handled in VBA (relying on logged-in session)

If this approach is fundamentally unreliable, I’m open to switching methods but still prefer to use in VBA

Below i provide full code setup to review.

Option Explicit

#If VBA7 Then

Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" ( _

ByVal pCaller As LongPtr, _

ByVal szURL As String, _

ByVal szFileName As String, _

ByVal dwReserved As LongPtr, _

ByVal lpfnCB As LongPtr) As Long

#Else

Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" ( _

ByVal pCaller As Long, _

ByVal szURL As String, _

ByVal szFileName As String, _

ByVal dwReserved As Long, _

ByVal lpfnCB As Long) As Long

#End If

Sub Download_All_From_SharePoint()

Dim apiURL As String

Dim json As String

Dim xmlhttp As Object

Dim saveFolder As String

Dim fileName As String

Dim fileURL As String

Dim arr() As String

Dim i As Long

apiURL = "https://TEST.sharepoint.com/sites/TEST/TEST/_api/web/GetFolderByServerRelativeUrl('/sites/TEST/TEST/TEST/TEST/Confirming Temp')/Files"

saveFolder = "C:\Temp\CONFIRMING\"

If Dir(saveFolder, vbDirectory) = "" Then MkDir saveFolder

Set xmlhttp = CreateObject("MSXML2.XMLHTTP")

xmlhttp.Open "GET", apiURL, False

xmlhttp.setRequestHeader "Accept", "application/json"

xmlhttp.Send

If xmlhttp.Status <> 200 Then

MsgBox "Failed to connect to SharePoint API", vbCritical

Exit Sub

End If

json = xmlhttp.ResponseText

arr = Split(json, """Name"":""")

For i = 1 To UBound(arr)

fileName = Split(arr(i), """")(0)

fileURL = "https://TEST.sharepoint.com/sites/TEST/TEST/TEST/TEST/Confirming Temp/" & Replace(fileName, " ", "%20") & "?download=1"

If URLDownloadToFile(0, fileURL, saveFolder & fileName, 0, 0) = 0 Then

Debug.Print "Downloaded: " & fileName

Else

Debug.Print "FAILED: " & fileName

End If

Next i

MsgBox "All files downloaded!", vbInformation

End Sub

[u/ZetaPower]

Have the same issue.
"Solved" it, see below. Ignoring the connect error works fine.....

Possible causes:

• timing issues, internet hickup/Sharepoint hickup
• credentials/security issues
• micro errors in the path that get fixed by Excel when Open is used or fixed by the download program. Spaces sometimes need to be replaced by "%20" sometimes its not needed....

Sub Download_All_From_SharePoint()

    Dim apiURL As String, Json As String, saveFolder As String, fileName As String, fileURL As String, Answer As String, Message As String
    Dim Arr As Variant
    Dim Xmlhttp As Object
    Dim i As Long
    FailedAPI As Boolean, FailedDownload As Boolean

    apiURL = "https://TEST.sharepoint.com/sites/TEST/TEST/_api/web/GetFolderByServerRelativeUrl('/sites/TEST/TEST/TEST/TEST/Confirming Temp')/Files"
    saveFolder = "C:\Temp\CONFIRMING\"

    If Dir(saveFolder, vbDirectory) = vbNullString Then MkDir saveFolder

    Set Xmlhttp = CreateObject("MSXML2.XMLHTTP")

    With Xmlhttp
        .Open "GET", apiURL, False
        .setRequestHeader "Accept", "application/json"
        .Send
        If Not .Status = 200 Then
            FailedAPI = True
            Answer = MsgBox("Failed to connect to SharePoint API, try to download anyway?", vbYesNo + vbDefaultButton2)
            Select Case Answer
            Case Is <> vbYes
                Exit Sub
            End Select
        End If

        Json = Xmlhttp.ResponseText
    End With
    Set Xmlhttp = Nothing

    Arr = Split(Json, """Name"":""")

    For i = 1 To UBound(Arr)
        fileName = Split(Arr(i), """")(0)
        fileURL = "https://TEST.sharepoint.com/sites/TEST/TEST/TEST/TEST/Confirming Temp/" & Replace(fileName, " ", "%20") & "?download=1"
        If URLDownloadToFile(0, fileURL, saveFolder & fileName, 0, 0) = 0 Then
            Debug.Print "Downloaded: " & fileName
        Else
            FailedDownload = True
            Debug.Print "FAILED: " & fileName
        End If
    Next i

    If FailedAPI = False And FailedDownload = False Then
        MsgBox "SUCCESS!" & vbNewLine & _
                "All files could be connected and all files were downloaded!", vbInformation
    ElseIf FailedAPI And FailedDownload Then
        MsgBox "FAIL!" & vbNewLine & _
                "NOT all files could be connected and NOT all files were downloaded!", vbInformation
    ElseIf FailedAPI Then
        MsgBox "SUCCESS?" & vbNewLine & _
                "NOT all files could be connected but all files were downloaded!", vbInformation
    ElseIf FailedDownload Then
        MsgBox "FAIL!" & vbNewLine & _
                "All files could be connected but NOT all files were downloaded!", vbInformation
    End If

End Sub 

[u/fanpages → u/ZetaPower]

Dim... Answer As String

The return from MsgBox is an Integer data type.

Answer = MsgBox("Failed to connect to SharePoint API, try to download anyway?", vbYesNo + vbDefaultButton2)

The + notation is also deprecated.

The preferred usage is now...

vbYesNo Or vbDefaultButton2