ななこ

クロムのWebdriverが合わないのでEdgeを使って登録してみた

久しぶりに動かしたらChromeとWebdriverのバージョンがどうにも合わなくなったので、Edgeを使うように変更しました。
作動させる前に、手動でwebdriverをインストールする。
その他、アカウントやパスワードを差し替える。
これで11/28現在動いて数十個クーポン登録できました。

---以下VBAマクロ

Sub ベネフィットステーションnanaco登録マクロ()

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



'クロムのWebdriverのバージョンが合わないのでEdgeを使う
    Driver.Start "edge"
'Driver.Start "chrome"

    Driver.Get "https://mypage.bs.benefit-one.inc/mypage/coupon/"

'自分のべネアカに変える
    Driver.FindElementByCss("#username").SendKeys "XXXXXXXX"

'自分のパスワードに変える
    Driver.FindElementByCss("#password").SendKeys "XXXXXXXX"

    Driver.FindElementByCss("#password-login-btn").Click

    Driver.Wait 2000

'   マイクーポンに以前のクーポンがある場合　nth-child(X)　のＸを変えるといいかも
' 実際に動かして確認

    Driver.FindElementByCss("#capture > main > div > div.mb-6 > ul > li:nth-child(1) > div > div:nth-child(2) > h3").Click

'Driver.FindElementByCss("#capture > main > div > div.mb-6 > ul > li:nth-child(X) > div > div:nth-child(2) > h3").Click

    Driver.Wait 1000

    i = 1


Do

    Driver.FindElementsByClass("c-checkbox__box")(i).Click

            i = i + 1

           xpath1 = "/html/body/div[1]/div/div[1]/main/div/div/div[1]/div/div[2]/div/div/ul/li["

            xpath3 = "]/div/div/label/div[1]"

            xpath2 = i

            xpath4 = xpath1 & xpath2 & xpath3


             flag = Driver.IsElementPresent(myBy.XPath(xpath4))

     Loop Until flag = False

Driver.FindElementByCss("#capture > main > div > div > div.p-mypage-coupon__header > div > div:nth-child(2) > div > div > div > div > button").Click

    Driver.Wait 1000

    For j = 1 To i - 1

            xpath1 = "/html/body/div[1]/div/div[1]/main/div/div/div[1]/div[2]/div[2]/div/div[1]/div[2]/ul/li["

            xpath3 = "]/div/div[3]/p[2]/span"

            xpath2 = j

            xpath4 = xpath1 & xpath2 & xpath3


    ActiveSheet.Cells(j, 1) = Driver.FindElementByXPath(xpath4).Text

    Next j

    k = 1

    Do

        nanacoURL = Cells(k, 1)

        If nanacoURL = "" Then Exit Do

        Driver.Start "edge"

        Driver.Get nanacoURL

        'nanaco番号入力

        Driver.FindElementByCss("#nanacoNumber01").SendKeys "XXXXXX"

        '会員メニュー用パスワード入力

        Driver.FindElementByCss("#pass").SendKeys "XXXXXX"

        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

       k = k + 1

    Loop
End Sub

nanacoギフトを一括登録するVBAマクロが途中で止まるとき

nanacoギフトを一括登録するVBAマクロが途中で止まるときがあります。
めげずにデバックボタンを押してから実行すると行けると思います。

また、クロムドライバーのバージョンが合ってないと
最初から動きません。
こちらもご注意ください。

nanacoギフトをマイクーポンから一括登録するVBAマクロでエラーが出た

以前に購入したnanacoギフトを未使用の場合、
マイクーポンに複数件表示されていると
前回のマクロが止まってしまいます。
2件の場合の解決法をお知らせします。

マイクーポンで「取得日が新しい順」で表示されていることを確認して、
コードの21行目を改変します。

（誤）
Driver.FindElementByCss("#capture > main > div > div.mb-6 > ul > li > div > div:nth-child(2) > h3").Click

（正）
Driver.FindElementByCss("#capture > main > div > div.mb-6 > ul > li:nth-child(2) > div > div:nth-child(2) > h3").Click

もっと多数の場合はこれを改変すればいいと思います。

Benefit Stationで購入したnanacoギフトをマイクーポンから一括登録するVBAマクロ

Benefit Stationで購入したnanacoギフトをマイクーポンから一括登録するVBAマクロ

2023年の4月にベネフィットステーションで
nanacoギフトを大量に購入しました。
いつまでたってもギフト番号を記載したメールが届かないので
おっかしーな、と思っていたところ、
どうやら仕様が変わったらしく
マイクーポンに届くようになりました。
そこからギフト番号を取得するように
マクロを改変しました。

下記コードで
ベネアカウント、ベネアカウントパスワード、
nanaco番号、会員メニューパスワード
以上4か所を自分のものに書き換えて
マクロを実行してください。

先にも述べましたように
全くスマートではなく
あくまで個人使用のマクロです。
無料でお使いいただけます。

2023年3月時点では
J's コンシェルで購入したギフトコードは
メールで送付されており
先のブログ記事で対応できると思います。
他は存じません。

---
Sub BenefitS用マクロ()

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


    Driver.Start "chrome"
    Driver.Get "https://mypage.bs.benefit-one.inc/mypage/coupon/"
    Driver.FindElementByCss("#username").SendKeys "ベネアカウント"

    Driver.FindElementByCss("#password").SendKeys "ベネアカウントパスワード"

    Driver.FindElementByCss("#password-login-btn").Click

    Driver.Wait 2000


    Driver.FindElementByCss("#capture > main > div > div.mb-6 > ul > li > div > div:nth-child(2) > h3").Click

    Driver.Wait 1000

    i = 1


Do

    Driver.FindElementsByClass("c-checkbox__box")(i).Click

            i = i + 1

           xpath1 = "/html/body/div[1]/div/div[1]/main/div/div/div[1]/div/div[2]/div/div/ul/li["

            xpath3 = "]/div/div/label/div[1]"

            xpath2 = i

            xpath4 = xpath1 & xpath2 & xpath3


             flag = Driver.IsElementPresent(myBy.XPath(xpath4))

     Loop Until flag = False

Driver.FindElementByCss("#capture > main > div > div > div.p-mypage-coupon__header > div > div:nth-child(2) > div > div > div > div > button").Click

    Driver.Wait 1000

    For j = 1 To i - 1

            xpath1 = "/html/body/div[1]/div/div[1]/main/div/div/div[1]/div[2]/div[2]/div/div[1]/div[2]/ul/li["

            xpath3 = "]/div/div[3]/p[2]/span"

            xpath2 = j

            xpath4 = xpath1 & xpath2 & xpath3


    ActiveSheet.Cells(j, 1) = Driver.FindElementByXPath(xpath4).Text

    Next j

    k = 1

    Do

        nanacoURL = Cells(k, 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

       k = k + 1

    Loop
End Sub

---

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

---