nanacoギフトをExcel-VBAで一括登録

手持ちのExcel デスクトップアプリのVBAでChromeを使って
nanacoギフトを大量に一括登録するツールを作りました。

以前はdett様のIEを動かすVBScriptを利用していましたが、
IEが使えなくなったり、
nanacoの会員ページの仕様が変更になったりで、
2022年秋頃から使えなくなってしまいました。
（dett様、その節は大変お世話になりました。）

webを検索すると似たようなツールはあるようですが、
PowerShellとかPowerAutomateを勉強するのは面倒だし、
（私にとって）一番身近なエクセルVBAのもので
無料のものは見つからなかったため
もうこうなったら作る方が楽に違いない！と信じて
マクロを作りました。
こちら、いつまでも素人なので全くスマートではありませんが。
無料でお使いいただけます。

nanacoギフトはベネフィットワンで購入しており、
えらべる俱楽部でもいけると思います。

転載禁止です。

手順
１）SeleniumBasicのインストール
　「vba selenium インストール」などのワードで検索してご自身でインストールし、エクセルで使えるようにしてください
２）エクセルのVBAに下記のコードをコピー
３）nanaco番号、パスワードを改変
４）ベネフィットワンから送られてくるメールの中身を
　　ワークシートの左上A1にコピー
５）マクロ"nanaco"を実行

コード
---
Sub nanaco()

    Dim Driver As New Selenium.WebDriver
    Dim target As Range
    Dim myBy As New By
    Dim nanacoURL As String

    Set target = Columns(1).Find("https://www.nanaco-net.jp/pc/emServlet?gid=", LookAt:=xlPart)
    i = 1

    Do

        nanacoURL = Right(Cells(target.Row, 1), 59)

        If nanacoURL = Cells(2, 2) Then Exit Do

        Cells(i, 2) = nanacoURL

        Set target = Columns(1).FindNext(target)

        i = i + 1

    Loop

    Range("B:B").Cut Range("A:A")

    j = 1

    Do
    
        nanacoURL = Cells(j, 1)
        
        If nanacoURL = "" Then Exit Do
     
        Driver.Start "chrome"

        Driver.Get nanacoURL
   
        'nanaco番号入力
        
        Driver.FindElementByCss("#nanacoNumber01").SendKeys "nanaco番号"
    
        '会員メニュー用パスワード入力
        
        Driver.FindElementByCss("#pass").SendKeys "パスワード"
    
        Driver.FindElementByCss("#loginPass01").Click
        
        Driver.FindElementByCss("#gift > a").Click
    
        Driver.FindElementByCss("#register > form > p > input[type=image]").Click
      
        Driver.SwitchToNextWindow
    
        FWFlag = False
    
        Do
        
            FWFlag = Driver.IsElementPresent(myBy.Css("#submit-button"))
        
            Driver.Wait 1000
 
        Loop Until FWFlag = True

        Driver.FindElementByCss("#submit-button").Click
    
        FWFlag1 = False
        
        FWFlag2 = False
           
        Do
        
            FWFlag1 = Driver.IsElementPresent(myBy.Css("#nav2Next > input[type=image]:nth-child(2)"))
            
            FWFlag2 = Driver.IsElementPresent(myBy.Css("#navNext > a > img"))
               
            Driver.Wait 1000
 
        Loop Until FWFlag1 = True Or FWFlag2 = True
         
        If FWFlag1 = True Then

            Driver.FindElementByCss("#nav2Next > input[type=image]:nth-child(2)").Click
           
            Driver.Quit
    
            Set Driver = Nothing
    
        Else
    
            Driver.Quit
    
            Set Driver = Nothing
    
        End If

        j = j + 1

    Loop

End Sub

---