【GAS×ChatGPT】ログインせずに株価を取得する方法　Part２

Sub GetPriceValue()
    ' 1. 対象のJSONデータ
    Dim jsonString As String
    jsonString = "{""code"":""1605"",""price"":3884.00}"　'数値を数値としてもらう
    
    ' 2. JSONをパース（解析）してオブジェクトに変換
    Dim Json As Object
    Set Json = JsonConverter.ParseJson(jsonString)
    
    ' 3. Priceの取り出し（Double型の数値として格納されます）
    Dim myPrice As Double
    myPrice = Json("price")
    
    ' 4. 結果を出力
    Debug.Print myPrice   ' イミディエイトウィンドウに「3884」と表示されます
    
    ' エクセルのセルに「3,884.00」と綺麗に表示させたい場合
    With Range("A1")
        .Value = myPrice
        .NumberFormatLocal = "#,##0.00" ' 表示形式を小数点2桁・カンマ付きに設定
    End With
End Sub

// ==========================================
// Excelから株価を取得する入口
// ==========================================
function doGet(e) {

  // ① Excelから銘柄コードを受け取る
  const code = e.parameter.code;

  // ② 銘柄コードが空の場合
  if (!code) {
    return ContentService
      .createTextOutput(JSON.stringify({
        error: "銘柄コードがありません"
      }))
      .setMimeType(ContentService.MimeType.JSON);
  }

  // ③ 既存の株価取得関数を呼び出す
  const price = StockPriceParserJP(code);

  // ④ Excelに返すデータを作る
  const result = {
    code: code,
    price: price
  };

  // ⑤ JSON形式でExcelに返す
  return ContentService
    .createTextOutput(JSON.stringify(result))
    .setMimeType(ContentService.MimeType.JSON);
}

// ==========================================
//
//         日本株価取得
//
// ==========================================
function StockPriceParserJP(code) {

  // ==========================================
  // 入力チェック
  // ==========================================

  if (!code) {
    return "N/A";
  }

  code = String(code).trim().toUpperCase();
  
  // ==========================================
  // Google Finance URL
  // ==========================================

  const url =
    "https://www.google.com/finance/quote/" +
    code +
    ":TYO" ;


  // ==========================================
  // Google Financeへアクセス
  // ==========================================

  const response = UrlFetchApp.fetch(url, {
    muteHttpExceptions: true,
    headers: {
      "User-Agent": "Mozilla/5.0"
    }
  });


  // ==========================================
  // HTTPエラー
  // ==========================================

  if (response.getResponseCode() !== 200) {
    return "N/A";
  }


  // HTML取得
  const html = response.getContentText();


  // ==========================================
  // HTML Parserで解析
  // ==========================================

  const dom = HtmlParser.parse(html);


  // ==========================================
  // 現在の株価を取得
  // ==========================================

  const priceElement =
    dom.querySelector('.N6SYTe [jsname="Pdsbrc"]');


  if (!priceElement) {
    return "価格が見つかりません";
  }


  // 株価文字列
  const priceText =
    priceElement.textContent.trim();


  Logger.log("現在値=" + priceText);


  if (!priceText) {
    return "価格が見つかりません";
  }


  // ==========================================
  // 通貨記号・カンマを削除
  // ==========================================
/*
  const numberText =
    priceText
      .replace("$", "")
      .replace("¥", "")
      .replace("￥", "")
      .replace(",", "")
      .trim();

*/
  // ==========================================
  // 数値に変換
  // ==========================================
/*
  const price = Number(numberText);


  if (isNaN(price)) {
    return "N/A";
  }

*/
  return priceText;
}

Sub responseテスト()

    Dim http As Object
    Dim url As String
    Dim response As String
   
    On Error GoTo ErrorHandler

    '========================================
    ' GAS WebアプリのURL
    '========================================
    url = "ここにGASのURLを入れる"
    
    ' 銘柄コード7203を送る
    url = url & "?code=7203"

    '========================================
    ' HTTP通信
    '========================================
    'Set http = CreateObject("MSXML2.XMLHTTP")
    Set http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    
    http.Open "GET", url, False
    http.Send

    '========================================
    ' GASから返ってきたJSON
    '========================================
    
    response = http.ResponseText

    '========================================
    ' 確認
    '========================================
    
    MsgBox response
    
    '========================================
    ' 後片付け
    '========================================
    Set http = Nothing
    
     Exit Sub

'========================================
' エラー処理
'========================================
ErrorHandler:

    MsgBox _
        "エラー番号：" & Err.Number & vbCrLf & _
        "エラー内容：" & Err.Description, _
        vbCritical, _
        "GAS接続エラー"

    Set http = Nothing
    
End Sub

Option Explicit
'========================================
' メインルーチン　株価リストに株価を求める
'========================================
Sub 日本株価取得()

    Dim i As Long
    Dim lastrow As Long
    Dim code As String
    Dim price As Double
    Dim change As Double
    Dim status As Long
        
    ' 銘柄コードの最終行を取得
    lastrow = kabuka.Cells(kabuka.Rows.Count, "A").End(xlUp).Row
        
    kabuka.Range("c2:d" & lastrow).ClearContents
    
    For i = 2 To lastrow
    
        Debug.Print i - 1 & "回目"
        code = CStr(kabuka.Cells(i, 1).Value)

        Call 株価取得(code, price, status)

        kabuka.Cells(i, 3).Value = price
        kabuka.Cells(i, 4).Value = status
    
    Next i
    MsgBox "株価更新しました！"
    End Sub
'========================================
' 株価を取得する　
'========================================
Sub 株価取得(code As String, kabuka As Double, status As Long)

    Dim http As Object
    Dim url As String
    Dim response As String
    
    Dim price As String
       
    On Error GoTo ErrorHandler
    
    status = 0
    
    '========================================
    ' GAS WebアプリURL
    '========================================
    url = "ここにデプロイしたURLを入れてね！"
    
    ' 銘柄コードを追加
    url = url & "?code=" & code

    Debug.Print "アクセスURL：" & url

    '========================================
    ' HTTPオブジェクト作成
    '========================================
    Set http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    'Set http = CreateObject("WinHttp.WinHttpRequest.5.1")

    '========================================
    ' GETリクエスト
    '========================================
         
    http.Open "GET", url, False
    
    http.SetRequestHeader "User-Agent", "Mozilla/5.0"
    
    http.Send
    status = http.status
     
    Debug.Print "Status：" & http.status
    Debug.Print "Response：" & http.ResponseText
    
    '========================================
    ' 結果取得
    '========================================
    response = http.ResponseText
    
    ' 通信状況が200以外なら、株価の解析を行わない
    If status <> 200 Then
        Set http = Nothing
        Exit Sub
    End If
    
    ' 株価データが含まれていない場合も解析しない
    If InStr(response, """price"":""") = 0 Then
    
        status = 0
        Set http = Nothing
        Exit Sub
    
    End If
    '========================================
    ' price を取り出す
    '========================================
    Dim p As Long
    
    p = InStr(response, """price"":""")
　　'p = InStr(response, Chr(34) & "price" & Chr(34) & ":" & Chr(34))でもOK!
   
    price = Mid(response, p + Len("""price"":"""))
    price = Left(price, InStr(price, """") - 1)

    Call Numeric_Henkan(price, kabuka)
　　 'kabuka = CDbl(price)でも数値に変換できます
   
    '========================================
    ' 結果確認
    '========================================

    Debug.Print "price：" & kabuka
   
    Set http = Nothing

    Exit Sub

'========================================
' エラー処理
'========================================
ErrorHandler:

    Debug.Print _
        "エラー番号：" & Err.Number & vbCrLf & _
        "エラー内容：" & Err.Description, _
        vbCritical, _
        "GAS接続エラー"
    Debug.Print "error :" & Format(Timer, "hh:mm:ss") & "秒"
    Set http = Nothing

End Sub
'========================================
' 文字を数値に
'========================================
Sub Numeric_Henkan(Moji As String, Suti As Double)

    ' ￥とカンマを削除して数値に変換
    Moji = Replace(Moji, "￥", "")
    Moji = Replace(Moji, "\", "") ' 半角￥にも対応
    Moji = Replace(Moji, ",", "")
    
    If IsNumeric(Moji) Then
        Suti = CDbl(Moji)
        'MsgBox "数値に変換しました: " & Suti
    
    End If

End Sub
'========================================
' エラー通信対応処理
'========================================
Sub エラー銘柄だけ再取得()

    Dim i As Long
    Dim lastrow As Long
    Dim code As String
    Dim price As Double
    Dim change As Double
    Dim status As Long

    ' 銘柄コードの最終行を取得
    lastrow = kabuka.Cells(kabuka.Rows.Count, "A").End(xlUp).Row

    ' 2行目から最終行まで確認
    For i = 2 To lastrow

        ' D列が200以外なら再取得
        If kabuka.Cells(i, "D").Value <> 200 Then

            code = CStr(kabuka.Cells(i, "A").Value)

            Debug.Print code & " を再取得します"

            ' 初期値
            price = 0
            change = 0
            status = 0

            ' 株価を再取得
            Call 株価取得(code, price, status)

            ' 結果をシートに反映
            If status = 200 Then

                kabuka.Cells(i, "C").Value = price
                kabuka.Cells(i, "D").Value = status

            Else

                ' 通信状況を更新
                kabuka.Cells(i, "D").Value = status

                Debug.Print code & " 再取得失敗：" & status

            End If

        End If

    Next i

    MsgBox "エラー銘柄の再取得が完了しました。", vbInformation

End Sub

function doGet(e) {
  const code = e.parameter.code;

  if (!code) {
  // 1. エラー時のレスポンスを直接生成して返す
  
    return createJson({
      error: "銘柄コードがありません"
    });
  }

  const url =
    "https://www.google.com/finance/quote/" +
    code +
    ":TYO?hl=ja";

  const response = UrlFetchApp.fetch(url, {
    muteHttpExceptions: true,
    headers: {
      "User-Agent": "Mozilla/5.0"
    }
  });

  const html = response.getContentText("UTF-8");

  const dom = HtmlParser.parse(html);

//株価の取得
  const priceElement =
    dom.querySelector('.N6SYTe [jsname="Pdsbrc"]');

//前日比の取得
  const changeElement =
    dom.querySelector('.wBomed [jsname="xnruHf"]');

  let price =
    priceElement
      ? priceElement.textContent.trim()
      : "#N/A";

  let change =
    changeElement
      ? changeElement.textContent.trim()
      : "#N/A";

  // 返却するオブジェクトを定義
  const data = {
    code: code,
    price: price,
    change: change
  };

  // 2. 正常時のレスポンスを直接生成して返す
  return ContentService
    .createTextOutput(JSON.stringify(data))
    .setMimeType(ContentService.MimeType.JSON);
}

Option Explicit
'========================================
' メインルーチン　株価リストに株価を求める
'========================================
Sub 日本株価取得()

    Dim i As Long
    Dim lastrow As Long
    Dim code As String
    Dim price As Double
    Dim change As Double
    Dim status As Long
        
    ' 銘柄コードの最終行を取得
    lastrow = kabuka.Cells(kabuka.Rows.Count, "A").End(xlUp).Row
        
    kabuka.Range("c2:e" & lastrow).ClearContents
    
    For i = 2 To lastrow
    
        Debug.Print i - 1 & "回目"
        code = CStr(kabuka.Cells(i, 1).Value)

        Call 株価取得(code, price, change, status)

        kabuka.Cells(i, 3) = price
        kabuka.Cells(i, 4) = change
        kabuka.Cells(i, 5) = status
    
    Next i
    MsgBox "株価更新しました！"
    End Sub
'========================================
' 株価を取得する　
'========================================
Sub 株価取得(code As String, kabuka As Double, Zenjituhi As Double, status As Long)

    Dim http As Object
    Dim url As String
    Dim response As String
    
    Dim price As String
    Dim change As String
    
    On Error GoTo ErrorHandler
    
    status = 0
    
    '========================================
    ' GAS WebアプリURL
    '========================================
    url = "ここにデプロイしたURLを入れてね！"

    ' 銘柄コードを追加
    url = url & "?code=" & code

    Debug.Print "アクセスURL：" & url

    '========================================
    ' HTTPオブジェクト作成
    '========================================
    Set http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    'Set http = CreateObject("WinHttp.WinHttpRequest.5.1")

    '========================================
    ' GETリクエスト
    '========================================
     
    Debug.Print "start :" & Format(Now, "hh:mm:ss") & "秒"
    
    http.Open "GET", url, False
    
    http.SetRequestHeader "User-Agent", "Mozilla/5.0"
        
    http.Send
         
    Debug.Print "Status：" & http.status
    status = http.status
    Debug.Print "Response：" & http.ResponseText
    
    Debug.Print "end :" & Format(Now, "hh:mm:ss") & "秒"
    '========================================
    ' 結果取得
    '========================================
    response = http.ResponseText
    
    ' 通信状況が200以外なら、株価の解析を行わない
    If status <> 200 Then
        Set http = Nothing
        Exit Sub
    End If
    
    ' 株価データが含まれていない場合も解析しない
    If InStr(response, """price"":""") = 0 Then
    
        status = 0
        Set http = Nothing
        Exit Sub
    
    End If
    '========================================
    ' price を取り出す
    '========================================
    Dim p As Long
    
    p = InStr(response, """price"":""")

    price = Mid(response, p + Len("""price"":"""))
    price = Left(price, InStr(price, """") - 1)

    Call Numeric_Henkan(price, kabuka)
    
    '========================================
    ' change を取り出す
    '========================================

    p = InStr(response, """change"":""")

    change = Mid(response, p + Len("""change"":"""))
    change = Left(change, InStr(change, """") - 1)

    Call Numeric_Henkan(change, Zenjituhi)

    '========================================
    ' 結果確認
    '========================================

    Debug.Print "price：" & kabuka
    Debug.Print "change：" & Zenjituhi

    Set http = Nothing

    Exit Sub

'========================================
' エラー処理
'========================================
ErrorHandler:

    Debug.Print _
        "エラー番号：" & Err.Number & vbCrLf & _
        "エラー内容：" & Err.Description, _
        vbCritical, _
        "GAS接続エラー"
    Debug.Print "error :" & Format(Timer, "hh:mm:ss") & "秒"
    Set http = Nothing

End Sub
'========================================
' 文字を数値に
'========================================
Sub Numeric_Henkan(Moji As String, Suti As Double)

    ' ￥とカンマを削除して数値に変換
    Moji = Replace(Moji, "￥", "")
    Moji = Replace(Moji, "\", "") ' 半角￥にも対応
    Moji = Replace(Moji, ",", "")
    
    If IsNumeric(Moji) Then
        Suti = CDbl(Moji)
        'MsgBox "数値に変換しました: " & Suti
    
    End If

End Sub
'========================================
' エラー通信対応処理
'========================================
Sub エラー銘柄だけ再取得()

    Dim i As Long
    Dim lastrow As Long
    Dim code As String
    Dim price As Double
    Dim change As Double
    Dim status As Long

    ' 銘柄コードの最終行を取得
    lastrow = kabuka.Cells(kabuka.Rows.Count, "A").End(xlUp).Row

    ' 2行目から最終行まで確認
    For i = 2 To lastrow

        ' E列が200以外なら再取得
        If kabuka.Cells(i, "E").Value <> 200 Then

            code = CStr(kabuka.Cells(i, "A").Value)

            Debug.Print code & " を再取得します"

            ' 初期値
            price = 0
            change = 0
            status = 0

            ' 株価を再取得
            Call 株価取得(code, price, change, status)

            ' 結果をシートに反映
            If status = 200 Then

                kabuka.Cells(i, "C").Value = price
                kabuka.Cells(i, "D").Value = change
                kabuka.Cells(i, "E").Value = status

            Else

                ' 通信状況を更新
                kabuka.Cells(i, "E").Value = status

                Debug.Print code & " 再取得失敗：" & status

            End If

        End If

    Next i

    MsgBox "エラー銘柄の再取得が完了しました。", vbInformation

            
End Sub