LoginSignup
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 3 years have passed since last update.

@pophope

クリックポストをVBAで少し自動化(へっぽこ）

Last updated at Posted at 2020-05-17

使う背景

・通販サイトを運営しており、
　小物の荷物を送るクリックポストをよく使うため（A4厚み3㎝で全国198円　2020年5月現在）

・手間が多いので（決済ボタンを何度も押す、荷物番号を取得し、楽天などに登録する作業）

今回は私がだいぶ前に作った、へっぽこVBAを説明します。
（へっぽこな理由は後ほど）

機能

VBAで作った機能は3つです。

  • 決済ボタンを押す
  • 送り状番号を取得
  • 楽天に送り状番号を登録

準備

  • csv

クリックポストはCSVで送り先、品名などを読み込ませることができます。
私の場合は、accessで並び替えるクエリを作り
csvの右端列に「受注番号」「数量」「モール名」があるデータをつかっています。

受注番号は、問い合わせ番号を楽天に登録するときに必要なため
数量は、商品2個でも1つのクリックポストで出荷できるときがあるので、それを見るため。
モール名は、問い合わせ番号を入れるときに必要なため

  • excel

こんな感じの見た目にしました。
class.jpg

A-H列はCSVと同じ内容です。
I列は受注番号
J列はお問合せ番号（
K列はモール名（楽天、amazonなど）
M列　RMSのID、パスワード、アドレス、パスワード2　決済ボタンのX座標、Y座標
N列　↑の実際の値を入れます。XとY座標はひとまず空白で

  • VBAの設定

CTRL + F11 から開発ツール
「ツール」→「参照設定」でIEが使えるように
「Microsoft Internet Controls」にチェックを入れています。
参照設定.jpg

へっぽこな理由

クリックポストの決済ボタンが押すプログラムがうまくできなくて（javascriptっぽい）
無理やりX座標とY座標でポイントを持っていて、そこを押すという処理にしています。
なので使うモニターによって、座標が変わってしまうので座標を調べないといけません。

こちらのサイトでF11で全画面表示して後ほど座標を調べるとうまくいくと思います。
マウスポインタの座標を調べる

同じような処理もあったりと無駄があるものへっぽこな理由です。
自分ひとり用なので動けばいいやーで作ってるのでご勘弁をーー

決済ボタンを押す処理

IEで
クリックポストにアクセスして送り先CSVを取り込みます。
10件あるなら、10回決済ボタンを押す作業があります。

最初の1回目だけはyahooのログイン情報を聞くため
1回目だけは手動で決済してください。

こちらがマクロです。
そのままコピペしてるので使っていない変数もあります。。。
エラーで「64bit declare ptrsafe　ほにゃほにゃ」と出てくる場合
Declare →Declare Ptrsafeにしてください。

clickpost.xlsm
Option Explicit
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'sleepを使う宣言

Declare Function SetCursorPos Lib "User32" (ByVal x As Long, ByVal y As Long) As Long
Declare Sub mouse_event Lib "User32" ( _
    ByVal dwFlags As Long, _
    Optional ByVal dx As Long = 0, _
    Optional ByVal dy As Long = 0, _
    Optional ByVal dwDate As Long = 0, _
    Optional ByVal dwExtraInfo As Long = 0)  '任意の場所をクリックするための宣言
   
    Const naiyou As Integer = 1 '内容物
    Const yubin As Integer = 3 '郵便番号
    Const sendad As Integer = 4 '住所
    Const sendname As Integer = 2 '送り先名
    Const telnum As Integer = 5 '電話番号
    Const recevier As Integer = 10 'お問い合わせ番号
  Sub paypush()
    Dim ie As InternetExplorer
    Dim img As HTMLImg '画像評価用のオブジェクト
    Dim button, objTag As HTMLInputButtonElement
    Dim objFrame As Object
    Dim url As String
    Dim i, j As Integer
    Dim pixel_x, pixel_y As Integer '決済の「次のボタン」
    
    pixel_x = Worksheets("クリックポスト").Range("N9").Value
    pixel_y = Worksheets("クリックポスト").Range("N10").Value
    
    j = InputBox("何件ありますか", "件数確認", "")
     'まとめ申込の画面にいるか確認
    
  
    '======================繰り返す
    For i = 1 To j
    Set ie = targeturl("https://clickpost.jp/labels/multiple_payment")
    'imgタグを1つずつ取り出し､「支払手続きをする」ボタンを押す｡
    For Each img In ie.document.getElementsByTagName("input")
        If img.Value = "支払手続きをする" Then
            img.Click                                                                   'クリックを押す
            Exit For                                                                      '脱出
        End If
    Next
    
     'ieが使えるまで待つ。
    ieCheck ie
   waitbrowsing ie
   Sleep 1500
    
    '決済画面なら、「次へ」を押すためのプログラム
    '=====================
   
    waitbrowsing ie
    ie.Width = 800
    ie.Height = 800
    ie.Left = 0
    ie.Top = 0
    ie.ExecWB 63, _
                    0, _
                        CLng(75) '表示率を75％にして
   
    SetCursorPos pixel_x, pixel_y 'x座標とY座標にカーソルを移動して無理やり押す
    Sleep 500
    mouse_event 2  '左ボタン押下のコード
    mouse_event 4  '左ボタン解放のコード
  '=====================
 '支払手続き確定ボタンを押す
 Set ie = targeturl("https://clickpost.jp/yahoo_wallet/confirm")
 For Each button In ie.document.getElementsByTagName("input")
        If button.Value = "支払手続き確定" Then
        button.Click
            Exit For
        End If
  Next
    
 Next  '30行目のfor
  MsgBox "終わりました"
End Sub


'URLに指定の文字が含まれるまで待つ関数
Function targeturl(urlmozi As String) As InternetExplorer
  Dim colsh As Object
  Dim strTemp As String
  Dim objIE As Object
  Dim flag As Integer

  strTemp = ""
 
  'フラッグを初期化
  flag = 0
  Do
    'flagが０なら、IEの分析を繰り返す
    Sleep 10
  
    '今あるIEをすべて取得します。
    Set colsh = CreateObject("Shell.Application")
    '一つずつ分解
    For Each objIE In colsh.Windows
      '分解したieのURLを取得する
        strTemp = objIE.LocationURL
        If InStr(strTemp, urlmozi) > 0 Then
          flag = 1
          Set targeturl = objIE
          ieCheck objIE
          Exit For
        End If
      '10ミリ秒待って再チャレンジ
      Sleep 10
      DoEvents
    Next
  Loop Until flag = 1

End Function


'処理待ち
Private Sub waitbrowsing(ie As InternetExplorer)
     Do While ie.Busy Or ie.readyState < READYSTATE_COMPLETE
        DoEvents
    Loop
 
End Sub

Sub ieCheck(objIE As InternetExplorer)

  Dim timeOut As Date
 '完全にページが表示されるまで待機する
  timeOut = Now + TimeSerial(0, 0, 20)

  Do While objIE.Busy = True Or objIE.readyState <> 4
    DoEvents
    Sleep 1
    If Now > timeOut Then
      objIE.Refresh
      timeOut = Now + TimeSerial(0, 0, 20)
    End If
  Loop

  timeOut = Now + TimeSerial(0, 0, 20)

  Do While objIE.document.readyState <> "complete"
    DoEvents
    Sleep 1
    If Now > timeOut Then
      objIE.Refresh
      timeOut = Now + TimeSerial(0, 0, 20)
    End If
   Loop

End Sub

解説

決済ボタンを押すための関数　paypush
指定したURLに来てるか確認する　targeturl
ページが使えるようになったか確認する iecheck
ページが使えるようになったか確認する waitbrowsing　同じことをしてる。。。無駄な記述。。

動きとしては
実行すると「何件ありますか？」と聞いてきます。
10件あったけど1件手動で処理したので、残り9件。
「9」を入れると9回ループ処理します。

DOMでinputの所をすべて調べて
それが「支払手続きをする」ならclick

無理やりページを左端に配置されて
XとY座標をカーソルが行き、そこを押します。（決済ボタンを押します。）

※地震があると、決済画面上に地震情報が表示されることがあり
ボタンがずれることがあります。座標を調整するか、地震がないことを祈りましょう。

クリックポストは出荷しないかぎり
実際には請求されない（はず）なので試しにやってみてください。

問い合わせ番号を取得する

WEB情報を取得するスクレイピングです。
今回はお客様の名前で探すようにしています。
同じお客様が同時に2点を買ったときに商品によって問番を変えるのが正しいですが
同じ日に出荷して同時につくので区別しなくても問題はありませんでした。

clickpost.xlsm
Sub numbercollect()
Dim ie As InternetExplorer
Dim htdoc As HTMLDocument '問い合わせ番号のhtmlを入れる
Dim re_htdoc As String 'htdocの全角、半角を削除
Dim number As String  '番号
Dim guestname As String '探すお客様名
Dim button As HTMLInputButtonElement
Dim sagasuhito As String '探す名前
Dim i, j, k As Integer

Set ie = targeturl("https://clickpost.jp/mypage/index")
 For i = 2 To Worksheets("クリックポスト").Cells(Rows.Count, 1).End(xlUp).Row '何件のデータがあるか
     
     sagasuhito = Worksheets("クリックポスト").Cells(i, sendname).Value  '探す名前を特定
     sagasuhito = Replace(sagasuhito, " ", "") '半角を削除する
     sagasuhito = Replace(sagasuhito, "　", "") '全角を削除する
     
        For k = 1 To 4
            ie.navigate "https://clickpost.jp/mypage/index?page=" & k
            
                For j = 1 To 10
                Set htdoc = ie.document.getElementsByClassName("col_receiver")(j) '名前を取得する
                re_htdoc = htdoc.innerText
                re_htdoc = Replace(re_htdoc, " ", "") '半角を削除
                re_htdoc = Replace(re_htdoc, "　", "") '全角を削除
                
                    If sagasuhito = re_htdoc Then  '探し人と名前が一致するなら
                    Worksheets("クリックポスト").Cells(i, 10).Value = ie.document.getElementsByClassName("col_package_number")(j).innerText
                
                    GoTo label1
        
        
                    End If '92行目のif
                Next '89行目のfor j
        Next '86行目のfor k

label1:   Next '80行のnext i
End Sub

解説

gotoを使ってるのがへっぽこですね。
あの時、俺も若かった。。

エクセルでの名前から半角全角を無くす。
クリックポストでの名前から半角全角を無くす。
名前が一致するなら、問番をエクセルに残しておいての流れです。

kがページ数　ここでは４ページまで見ています。
１ページ１０件あるので、４０件分をチェックしています。

楽天に問番を登録する

やりたいことは

楽天にログインして
お客様の個別注文まで移動して
荷物情報の所に「日本郵便」「問番」「今日出荷」を選択して
登録をする

このループです。

clickpost.xlsm
Sub rakutenlogin()
    Dim ie As InternetExplorer
    Dim loginid As HTMLTextAreaElement
    Dim loginpw, user_passwd As HTMLTextAreaElement
    Dim userid As HTMLTextAreaElement
    Dim i As Integer
    Dim a As String
    
    Dim button As HTMLInputButtonElement
    
    
   Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = True
    ie.navigate "https://glogin.rms.rakuten.co.jp/?sp_id=1"
    '楽天のホームページまで到着する
    waitbrowsing ie
    
    'IDを入れる
    Set loginid = ie.document.getElementsByName("login_id")(0)
    loginid.Value = Worksheets("クリックポスト").Range("N2").Value
    
    'パスワードを入れる
    Set loginpw = ie.document.getElementsByName("passwd")(0)
    loginpw.Value = Worksheets("クリックポスト").Range("N3").Value
        
    'input要素を1つずつ精査して、特定のものをクリックさせる。
    For Each button In ie.document.getElementsByName("submit")
        If button.name = "submit" Then
        button.Click
            Exit For
        End If
    Next
    
    '処理待ち関数
    waitbrowsing ie
    
    'アドレスを入れる
    Set userid = ie.document.getElementsByName("user_id")(0)
    userid.Value = Worksheets("クリックポスト").Range("N4").Value
    
    'パスワードを入れる
    Set user_passwd = ie.document.getElementsByName("user_passwd")(0)
    user_passwd.Value = Worksheets("クリックポスト").Range("N5").Value
    
     'input要素を1つずつ精査して、特定のものをクリックさせる。
    For Each button In ie.document.getElementsByName("submit")
        If button.name = "submit" Then
        button.Click
            Exit For
        End If
    Next
    
    '処理待ち関数
    waitbrowsing ie
    
     'input要素を1つずつ精査して、特定のものをクリックさせる。次を押す
    For Each button In ie.document.getElementsByName("submit")
        If button.Type = "submit" Then
        button.Click
            Exit For
        End If
    Next
    
    '処理待ち関数
    waitbrowsing ie
    
     'input要素を1つずつ精査して、特定のものをクリックさせる。「上記を遵守していることを確認の上、RMSを利用します」を押す
    For Each button In ie.document.getElementsByTagName("input")
        If button.Type = "submit" Then
        button.Click
            Exit For
        End If
    Next
    
    '処理待ち関数
    waitbrowsing ie
    
    
    '桁数分だけ処理をする。
    With Worksheets("クリックポスト")
    For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
          If .Cells(i, 11).Value = "楽天" Then
         ie.navigate "https://order.rms.rakuten.co.jp/rms/mall/order/rb/vc?__event=BO02_001_013&order_number=" & .Cells(i, 9).Value
        waitbrowsing ie
        
       'input要素を1つずつ精査して、特定のものをクリックさせる。
        For Each button In ie.document.getElementsByTagName("input")
        If InStr(button.name, "shipping_number") > 0 Then  'instrで指定言葉を含まれるなら
            button.Value = .Cells(i, recevier).Value          'クリックを押す
            Exit For                                                                      '脱出
        End If
        Next
        
        '日本郵便を選択する
        Dim select_delivery As HTMLSelectElement
        For Each select_delivery In ie.document.getElementsByTagName("select")
        If InStr(select_delivery.name, "deliver_company") > 0 Then  'instrで指定言葉を含まれるなら
            select_delivery.Value = "1003"          'クリックを押す
            Exit For                                                                      '脱出
        End If
        Next
        
         'input要素を1つずつ精査して、特定のものをクリックさせる。「上記を遵守していることを確認の上、RMSを利用します」を押す
        For Each button In ie.document.getElementsByTagName("input")
        If button.Type = "submit" And button.Value = "入力内容を反映する" Then
        button.Click
            Exit For
        End If
    Next
    
    waitbrowsing ie
        Else
        End If
    Next i
    End With
     MsgBox "終わりました"
    
End Sub

解説

エクセルのN列で楽天のパスワードを
楽天のフォームに入れて、ボタンを押してログインします。

楽天の余計なお知らせが多いとうまくいきません。
その時は「以後表示しない」をチェックして再度ログイン

楽天のお客様の個別情報は
URLに受注番号を合体しただけのため
それで個別ページに飛びます。

荷物情報の所に「日本郵便」「問番」「今日出荷」を選択して
登録ボタンを押す流れです。

このVBAは今日出荷の所が抜けてるっぽいです。

おわりに

自分だけが使えたらいいだけで作ったもので
だいぶ前に作ったので、あまり詰めずに即席で作ったVBAでした。
javascriptもよくわかっていないので、決済の際に地震がないことを祈るだなんて。。

目的がハッキリあって、かつ毎日の作業で使うものなので
できた時はめっちゃ感動したのを覚えています。

プログラミング勉強でよく言われる
「それにまず理想像を設定して、
　それに合わせて必要な知識を集めてつくる」という感じたVBAでした。

※
yahoo,wowmaに荷物番号を登録する場合はcsvで登録できるので
受注番号と問番をコピペしてcsvを作ればOKです。
楽天もCSVで登録できるけど余計な管理番号みたいなものが必要になるので
むりやりIEでログインさせています。

0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?