Salesforce資格取得者数のPDFファイルをダウンロードするマクロ

#初めに
Salesforceに関係はしますが，VBAだけの内容になります．

Salesforce 認定資格保持者数 企業別一覧が公開されています。資格ごとで毎月のファイルを一つ一つ見ているだけではあまり意味のある情報が得られないかもしれませんが，まとめてみると何か見えてくるかもしれません．
今回は，指定した複数のファイルを指定したフォルダにダウンロードするExcel VBAです。

動作環境

Windows 10上のOffice365(64bit)のExcelで確認してます．古いOfficeでは動作しないかもしれません．

おことわり

環境に依存することや、VBAの使い方など基本的な内容はご自身で解決してください。

機能 - PDFファイルのダウンロード

数式ー名前の管理でダウンロードフォルダと資格の一覧の場所が定義されていますので確認してください．
資格一覧シートのB1セルにダウンロード先のフォルダ名を書いておき、"ファイルのダウンロード"ボタンをクリックするとファイルがダウンロードされます。終了すると終了したとメッセージボックスで表示します。

#マクロ

Option Explicit

Private Declare PtrSafe 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

Function DownloadPDFFile(url As String, path As String) As Boolean
    DownloadPDFFile = False
    Dim lRes As Long
    lRes = URLDownloadToFile(0, url, path, 0, 0)
    If lRes = 0 Then ' エラーなし
        DownloadPDFFile = True
    End If
End Function

Sub DownloadPDFFiles()
    Dim r As Range
    Dim strDLFolder As String

    strDLFolder = ThisWorkbook.Names("ダウンロードフォルダ").RefersToRange.Cells(1, 1).Value
    If strDLFolder = "" Then
        MsgBox "ダウンロード先フォルダ名が空なので終了します"
        Exit Sub
    End If
    If Dir(strDLFolder, vbDirectory) = "" Then
        MkDir strDLFolder
    End If
    
    Dim rangeExam As Range
    Set rangeExam = ThisWorkbook.Names("Salesforce認定資格").RefersToRange
    For Each r In rangeExam.Rows
        r.Cells(1, 6) = ""
    Next
    
    MsgBox strDLFolder & vbCrLf & "にファイルをダウンロードします", vbOKOnly
    
    For Each r In rangeExam.Rows
        Dim strFileName As String
        Dim strUrl As String
        '列番号は 1:略称 2:URL 3:ファイル名 4:分類 5:資格名 7:DL状況 8:取り込み
        strUrl = r.Cells(1, 2)
        strFileName = strDLFolder + "\" + Mid(strUrl, InStrRev(strUrl, "/") + 1)
        r.Cells(1, 6) = "*"
        If DownloadPDFFile(strUrl, strFileName) = False Then
            r.Cells(1, 6) = "失敗"
        Else
            r.Cells(1, 6) = "完"
        End If
        DoEvents
    Next
    MsgBox "取り込み完了しました", vbOKOnly
End Sub

#ファイル
Bitbucketにおいてあります
SF資格取得者数.xlsmをダウンロードしてください