はじめに
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をダウンロードしてください