[PR]上記の広告は3ヶ月以上新規記事投稿のないブログに表示されています。新しい記事を書く事で広告が消えます。
手持ちのExcel デスクトップアプリのVBAでChromeを使って
nanacoギフトを大量に一括登録するツールを作りました。
以前はdett様のIEを動かすVBScriptを利用していましたが、
IEが使えなくなったり、
nanacoの会員ページの仕様が変更になったりで、
2022年秋頃から使えなくなってしまいました。
(dett様、その節は大変お世話になりました。)
webを検索すると似たようなツールはあるようですが、
PowerShellとかPowerAutomateを勉強するのは面倒だし、
(私にとって)一番身近なエクセルVBAのもので
無料のものは見つからなかったため
もうこうなったら作る方が楽に違いない!と信じて
マクロを作りました。
こちら、いつまでも素人なので全くスマートではありませんが。
無料でお使いいただけます。
nanacoギフトはベネフィットワンで購入しており、
えらべる俱楽部でもいけると思います。
転載禁止です。
手順
1)SeleniumBasicのインストール
「vba selenium インストール」などのワードで検索してご自身でインストールし、エクセルで使えるようにしてください
2)エクセルのVBAに下記のコードをコピー
3)nanaco番号、パスワードを改変
4)ベネフィットワンから送られてくるメールの中身を
ワークシートの左上A1にコピー
5)マクロ"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
---
1. 初めまして。
Re:初めまして。
記事の下の方
2つのーーーの間の部分を
エクセルのVBAのところにコピペして
実行するだけです。
よろしくお願いします。