以前公開した記事に対してソース公開希望のコメントがありましたので抜粋を公開してみたいと思う。

 

 

 

(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名を利用しているが、これは理由は分からないが値の取得ができるかできないかで試行錯誤して切り分けている。