はじめに

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

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

それでPDFファイルをダウンロードし、PDFファイルの資格取得者情報をExcelに取り込むVBAマクロを作ってみました。

PDFファイルのダウンロードのマクロについては一つ前の記事のSalesforce資格取得者数のPDFファイルをダウンロードするマクロを見てください。

動作環境

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

おことわり

環境に依存することや基本的な内容はご自身で解決してください．
新しい資格が出た場合や削除された場合は資格一覧を修正してください。
PDFファイルの構造が変わってしまったりして，インポートに失敗することがそこそこありました．問題が発生したときは修正を待つかご自身でマクロを修正してください．

機能 - 資格取得者数のダウンロード

数式ー名前の管理でダウンロードフォルダと資格の一覧の場所が定義されていますので確認してください．
資格一覧シートのB1セルにダウンロード済のファイルがあるフォルダ名を書いておきます．
（ダウンロードしてない場合は”ファイルのダウンロード”ボタンでダウンロードしてください）
"PDFファイルのインポート"ボタンをクリックするとファイルのインポートが開始されます。

Wordを使って内容を読み込むので、Wordが開きます。

終了するとメッセージボックスが表示されます。

数式の名前で定義してある”資格取得者数”をもとにピボットテーブルやグラフを作成するといろいろ分析ができると思います

私はデザイナー試験の取得順に、取得者数が多いものを優先しました。

マクロ

'Copyright 2019 Yuji OKAZAKI
'
'Licensed under the Apache License, Version 2.0 (the "License");
'you may not use this file except in compliance with the License.
'You may obtain a copy of the License at
'
'    http://www.apache.org/licenses/LICENSE-2.0

'Unless required by applicable law or agreed to in writing, software
'distributed under the License is distributed on an "AS IS" BASIS,
'WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
'See the License for the specific language governing permissions and
'limitations under the License.

Option Explicit

Sub AppendNumOfCertHolder(w As Worksheet, ByRef r As Long, c As Long, strCompany As String, strDt As String, strCertName As String, strNum As String)
    w.Cells(r, c + 0).Value = strCompany
    w.Cells(r, c + 1).Value = strDt
    w.Cells(r, c + 2).Value = strCertName
    w.Cells(r, c + 3).Value = strNum
    r = r + 1
End Sub

Sub GetLastPosition(strName As String, ByRef w As Worksheet, ByRef r As Long, ByRef c As Long)
    Dim n As name
    Set n = ThisWorkbook.Names(strName)
    Dim rng As Range
    Set rng = n.RefersToRange
    
    Set w = rng.Worksheet
    c = rng.Column
    r = rng.Row + rng.Rows.Count
End Sub

Sub ResizeName(strName As String, w As Worksheet, r As Long, c As Long)
    Dim n As name
    Set n = ThisWorkbook.Names(strName) '"資格取得者数"
    Dim rng As Range
    Set rng = n.RefersToRange
    Dim rangeNew As Range
    Set rangeNew = rng.Worksheet.Range( _
                        rng.Worksheet.Cells(rng.Row, rng.Column), _
                        rng.Worksheet.Cells(r, rng.Column + rng.Columns.Count - 1))

    n.Delete
    ActiveWorkbook.Names.Add strName, rangeNew
End Sub
'wApp As Word.Application
Function ImportPDFFile(wApp, strDLFolder As String, rng As Range, w As Worksheet, r As Long, c As Long) As Boolean
    ImportPDFFile = False
    Dim strUrl As String
    Dim strFileName As String
    Dim strText As String
    '資格データは列番号で 1:略称 2:URL 3:ファイル名 4:分類 5:資格名 6:最終取得日
'    strFileName = strDLFolder + "\" + rng.Cells(1, 3)
    strUrl = rng.Cells(1, 2)
    If strDLFolder <> "" Then
        strFileName = strDLFolder + "\" + Mid(strUrl, InStrRev(strUrl, "/") + 1)
        If Dir(strFileName, vbNormal) = "" Then
            MsgBox "ファイルが見つかりません。以後の処理を終了します"
            Exit Function
        End If
    Else
        strFileName = strUrl
    End If

    Dim wDoc 'As Word.Document
    Set wDoc = wApp.Documents.Open(Filename:=strFileName, ConfirmConversions:=False, ReadOnly:=True)
    
    Dim wTbl 'As Word.Table
    '===========================================
    ' PDFファイルから日付の情報を取得します
    Dim dt As Date
    strText = Split(wDoc.Range.Text, vbCr)(1)
    If InStr(1, strText, "現在") > 0 Then '試験名が長い場合こちらに来る
        strText = Split(strText, "】" & vbTab)(1)
    Else '試験名が短い場合はこっちにくる
        strText = Split(wDoc.Range.Text, vbCr)(2)
        strText = Right(strText, Len(strText) - 1) '頭にごみがあるので削除
    End If
    If InStr(1, strText, "現在") <= 0 Then
        MsgBox "日付の取得に失敗しました。処理を中断します"
        Exit Function
    End If
    dt = DateValue(Split(strText, "現在")(0))
    If rng.Cells(1, 5) >= dt Then '最終取得日よりも新しいデータならデータを取得します
        MsgBox "最終取得日よりも古いデータでしたので，処理を終了します"
        wDoc.Close False
        Exit Function
    End If
    
    '===========================================
    Dim nRows As Integer
    Dim strCompany As String, strDt As String, strCertName As String, strNum As String
    strDt = FormatDateTime(dt, vbShortDate)
    strCertName = rng.Cells(1, 1)
    nRows = 0
    For Each wTbl In wDoc.Tables
        'テーブルとはページの切れ目みたい
        Dim wRow 'As Word.Row
        For Each wRow In wTbl.Rows
            '1行1行の処理
            If wRow.Cells.Count = 2 And _
               InStr(1, wRow.Cells(2).Range.Text, "名") > 0 Then
                '２列(社名,人数)データがあり、右に"名"がある場合のみデータを取得します
                strCompany = Trim(Split(wRow.Cells(1).Range.Text, vbCr)(0))
                strNum = Trim(Split(wRow.Cells(2).Range.Text, "名")(0))
                AppendNumOfCertHolder w, r, c, strCompany, strDt, strCertName, strNum
                nRows = nRows + 1
                DoEvents
            End If
        Next
    Next
    'Salesforce 認定 B2C Commerce Technical Solution デザイナー が表になってないので特別に
    If nRows = 0 Then
        Dim l As Variant
        Debug.Print wDoc.Range.Text
        For Each l In Split(wDoc.Range.Text, vbCr)
            If InStr(1, l, "資格保持者数") > 0 And Right(l, 1) = "名" Then
                ' 2020/01 ”企業名（ABC50音順） 資格保持者数”の次の行も同時に取れる
                l = Split(l, "資格保持者数")(1) ' ので前半を捨てる
            End If
            If InStr(1, l, vbTab) > 0 And Right(l, 1) = "名" Then
                strCompany = Split(Split(l, "名")(0), vbTab)(0)
                strNum = Split(Split(l, "名")(0), vbTab)(1)
                AppendNumOfCertHolder w, r, c, strCompany, strDt, strCertName, strNum
                DoEvents
            End If
        Next
    End If
    wDoc.Close False
    DoEvents
    rng.Cells(1, 5) = dt 'SFDCが情報を取得した時刻を設定
    ImportPDFFile = True
End Function

Sub ImportPDFFiles()
    Dim rng As Range
    Dim strDLFolder As String
    Dim fweb As Boolean
    fweb = False
    If fweb = False Then
        strDLFolder = ThisWorkbook.Names("ダウンロードフォルダ").RefersToRange.Cells(1, 1).Value
        If Dir(strDLFolder, vbDirectory) = "" Then
            MsgBox "ダウンロードフォルダが作成されていません"
            Exit Sub
        End If
    End If
    Dim wApp 'As Word.Application
    Set wApp = CreateObject("Word.application")
    wApp.Visible = True
    wApp.DisplayAlerts = False
    
    Dim rangeExam As Range
    Set rangeExam = ThisWorkbook.Names("Salesforce認定資格").RefersToRange
    
    Dim w As Worksheet, r As Long, c As Long
    GetLastPosition "資格取得者数", w, r, c
    
    For Each rng In rangeExam.Rows
        rng.Cells(1, 6) = ""
    Next
    
    For Each rng In rangeExam.Rows
        '資格の数だけのループを回る
        rng.Cells(1, 6) = "*"
        If ImportPDFFile(wApp, strDLFolder, rng, w, r, c) = False Then
            Exit For ' エラーがあったら中断する
            rng.Cells(1, 6) = "Error"
        End If
        rng.Cells(1, 6) = "完"
    Next
    ResizeName "資格取得者数", w, r - 1, c
    wApp.Quit False
    MsgBox "取り込み完了しました", vbOKOnly
End Sub

ファイル

Qiitaへファイルの添付方法がわからなかったので、Bitbucketにおいてあります
SF資格取得者数.xlsmをダウンロードしてください