以前公開した記事に対してソース公開希望のコメントがありましたので抜粋を公開してみたいと思う。
(1)概要
IE操作のVBAマクロを作成し、Excelに管理している投信情報(URL)から投信情報の基準価額などを取得していた。
管理していたExeclは以下の通り。
投信情報を提供しているサイトはこちら。(下図参照)
このサイトから、基準価額、直近配当金、直近配当日、前回配当金、前回配当日、運用会社を取得した。
(2)ソースコード
Sub m_Get基準価額()
Dim ie As Object
Dim lFlg As Boolean
Set ie = CreateObject("internetexplorer.application")
ie.Visible = True
Set oS = Selection
For Each oSel In oS
If Cells(oSel.Row, cUrl).value = "" Then GoTo next_oSel
If oSel.value = "" Then GoTo next_oSel
If ActiveSheet.Rows(oSel.Row).Hidden = True Then GoTo next_oSel
lUrl = Cells(oSel.Row, cUrl).value
lName = Cells(oSel.Row, c銘柄).value
'同じURLあるか
Cells(oSel.Row, cUrl).Select
ie.Navigate lUrl
time10 = DateAdd("s", 10, Now())
Do While ie.busy Or ie.readyState <> 4
DoEvents
If time10 < Now() Then Exit Do
Loop
GoSub p_proc
Cells(oSel.Row, cUrl).ClearComments
Cells(oSel.Row, cUrl).AddComment
Cells(oSel.Row, cUrl).Comment.Text Text:=Format(Now(), "yyyy/mm/dd hh:mm:ss")
Cells(oSel.Row, cUrl).Comment.Visible = False
next_oSel:
Next
ie.Quit
Set rtn = Nothing
Set ie = Nothing
Set oTg = Nothing
Set oS = Nothing
Set oSel = Nothing
Set oUrl = Nothing
Exit Sub
p_proc:
'実行ボタンクリック
'--------------------------------------------------------------------------
'運用会社
Set oTg = ie.document.GetElementsByClassName("fds-gray-fg fds-text-word-break")(1)
Cells(oSel.Row, c運用会社).value = Replace(oTg.outertext, "運用会社名: ", "")
Set oTg = Nothing
'--------------------------------------------------------------------------
'--------------------------------------------------------------------------
'基準価額
Set oTg = ie.document.GetElementsByClassName("h3 font-weight-bold")(0)
Cells(oSel.Row, c基準価額).value = oTg.outertext
Set oTg = Nothing
'--------------------------------------------------------------------------
'--------------------------------------------------------------------------
'直近分配金
Set oTg = ie.document.GetElementById("dividendInfo")
lVal1 = oTg.Cells(4).outertext '直近配当金
lVal2 = oTg.Cells(3).outertext '直近配当日
lVal3 = oTg.Cells(6).outertext '前月配当金
lVal4 = oTg.Cells(5).outertext '前月配当日
lVal5 = "(" & lVal4 & " = " & lVal3 & ")"
lVal4 = Replace(lVal3, "円", "")
Cells(oSel.Row, c直近配当).value = Replace(lVal1, "円", "")
On Error Resume Next
Cells(oSel.Row, c直近配当).ClearComments
Cells(oSel.Row, c直近配当).AddComment
Cells(oSel.Row, c直近配当).Comment.Text Text:=lVal2 & Chr(10) & lVal5
Cells(oSel.Row, c直近配当).Comment.Shape.Width = 130
If Cells(oSel.Row, c直近配当).value < CInt(lVal4) Then
Cells(oSel.Row, c直近配当).Comment.Shape.DrawingObject.Interior.ColorIndex = 3 '赤
ElseIf Cells(oSel.Row, c直近配当).value > CInt(lVal4) Then
Cells(oSel.Row, c直近配当).Comment.Shape.DrawingObject.Interior.ColorIndex = 5 '青
End If
Cells(oSel.Row, c直近配当).Comment.Visible = False
On Error GoTo 0
Set oTg = Nothing
'--------------------------------------------------------------------------
Return
End Sub
(3)解説
Excel上でAlt+F11を押下し「Visual Basic Editor」を起動。
「標準モジュール」上で右クリック「挿入」→「標準モジュール」で追加されたModuleに上記ソースコードを貼り付け。
特定の列を選択した状態でマクロを実行すると、A列に設定したURLをIEで表示し、情報(基準価額、直近配当金、直近配当日、前回配当金、前回配当日、運用会社)を取得したのちにExcelに張り付ける。
ソースコードには取得したい情報のHTMLの要素名を知る必要がある。サイトのソース表示(F12を押下)をすると知ることが出来る。例えば、基準価格はClassNameを利用しているがその名称は"h3 font-weight-bold"だ。
項目によってClassNameを利用したりID名を利用しているが、これは理由は分からないが値の取得ができるかできないかで試行錯誤して切り分けている。