Airペイ と 楽天ペイ 、重複して契約は大丈夫？
普段はジャマな「チャットで問い合わせ」してみたら問題ないとのことで、
「Airペイ」に続き「楽天ペイ」での決済もできるようにした。
色違いの決済端末が２台並ぶ。
【Airペイ】A4プリンタでクレジットカード利用票を自動印刷
でやったように、楽天ペイのクレジットカード利用票（ご利用控え）も対応しよう！
概要
カード決済完了時、決済端末から印刷用に用意したメールアドレスに「利用票メール」を送信すると、PCに接続されたプリンタ（A4インクジェット利用）から、「クレジットカード利用票」がA6用紙で出力される。
変更点
・楽天ペイ用の利用票印刷サブルーチンを追加
・楽天ペイ用の仕訳ルールを追加
・テストや再印刷のため、仕訳ルール実行機能を作成
VBコード
Airペイ利用票印刷サブルーチン
Public Sub PrintMailBody(ByRef Item As Outlook.MailItem)
On Error GoTo Err_PrintMailBody
'Airペイ利用票印刷サブルーチン
'利用票メールから本文を抜き出しワードで印刷（テンプレート使用）
Dim ExtText As String
Dim StaText As String
Dim EndText As String
Dim StaPos As Integer
Dim EndPos As Integer
'利用票メール文中の必要な部分の始まりと終わりを指定
StaText = String(5, "=")
EndText = String(20, "=")
StaPos = InStr(Item.Body, StaText)
EndPos = InStr(Item.Body, EndText)
'利用票メールの内容を部分的にカスタマイズ
ExtText = Replace(Mid(Item.Body, StaPos, EndPos - StaPos), "このメールを", "この利用票を")
Const wdDoNotSaveChanges = 0
With CreateObject("Word.Application")
.Visible = False
'現行プリンタ名を調べ、出力プリンタを指定する（現行プリンタを変更しない）
' MsgBox .activeprinter
.WordBasic.FilePrintSetup Printer:="PX-105 Series(ネットワーク)", DoNotSetAsSysDefault:=1
'利用票テンプレートをフルパスで指定
With .Documents.Add("C:\Users\xxxxx\Documents\Office のカスタム テンプレート\クレジットカードご利用票.dot")
.Content.InsertAfter Text:=ExtText
.PrintOut False
.Close wdDoNotSaveChanges
End With
.Quit wdDoNotSaveChanges
End With
Exit_PrintMailBody:
Exit Sub
Err_PrintMailBody:
MsgBox Err.Description
Resume Exit_PrintMailBody
End Sub
楽天ペイ利用票印刷サブルーチン
Public Sub PrintMailBody_RPay(ByRef Item As Outlook.MailItem)
On Error GoTo Err_PrintMailBody_RPay
'楽天ペイ利用票印刷サブルーチン
'利用票メールから本文を抜き出しワードで印刷（テンプレート使用）
Dim ExtText As String
Dim StaText As String
Dim EndText As String
Dim StaPos As Integer
Dim EndPos As Integer
'利用票メール文中の必要な部分の始まりと終わりを指定
StaText = "ご利用明細"
EndText = "お支払いは、各カード会社が発行するご利用代金明細書でご確認ください。"
StaPos = InStr(Item.Body, StaText)
EndPos = InStr(Item.Body, EndText) + Len(EndText)
'利用票メールの内容を部分的にカスタマイズ
ExtText = Replace(Mid(Item.Body, StaPos, EndPos - StaPos), "このメール", "この利用票")
ExtText = Replace(ExtText, "<https://smartpay.rakuten.co.jp/img/mailmagazine/common/email/spacer.gif>", "")
ExtText = Replace(ExtText, vbTab, "")
'余分なｽﾍﾟｰｽ2+CRLFを消す
ExtText = Replace(ExtText, " " + vbCr + vbLf + " ", "")
Const wdDoNotSaveChanges = 0
With CreateObject("Word.Application")
.Visible = False
'現行プリンタ名を調べ、出力プリンタを指定する（現行プリンタを変更しない）
' MsgBox .activeprinter
.WordBasic.FilePrintSetup Printer:="PX-105 Series(ネットワーク)", DoNotSetAsSysDefault:=1
'利用票テンプレートをフルパスで指定
With .Documents.Add("C:\Users\xxxxx\Documents\Office のカスタム テンプレート\クレジットカードご利用票.dot")
.Content.InsertAfter Text:=ExtText
.PrintOut False
.Close wdDoNotSaveChanges
End With
.Quit wdDoNotSaveChanges
End With
Exit_PrintMailBody_RPay:
Exit Sub
Err_PrintMailBody_RPay:
MsgBox Err.Description
Resume Exit_PrintMailBody_RPay
End Sub
テストや再印刷のために、手動で実行するサブルーチンを作成
印刷したい利用票メールの「開封済み」を「未読」に変更してから実行する
Public Sub RunPrintRule()
'利用票印刷ルールを手動で実行
Dim colRules As Outlook.Rules
Dim oRule As Outlook.Rule
Dim oInbox As Outlook.Folder
Dim oStore As Outlook.Store
'利用票メールアドレスを設定
Set oStore = Application.Session.Stores.Item("xxxxx@xxxxx.com")
'Specify target folder for rule move action
Set oInbox = oStore.GetDefaultFolder(olFolderInbox)
'Get Rules from Session.DefaultStore object
Set colRules = oStore.GetRules()
'Create the rule by adding a Receive Rule to Rules collection
'Airペイの仕訳ルール実行（未読メール対象）
Set oRule = colRules.Item("クレジットカード利用票印刷")
oRule.Execute True, oInbox, False, olRuleExecuteUnreadMessages
'楽天ペイの仕訳ルール実行（未読メール対象）
Set oRule = colRules.Item("クレジットカード利用票印刷RPay")
oRule.Execute True, oInbox, False, olRuleExecuteUnreadMessages
End Sub
ホームバー（リボン）に手動で実行するボタンを配置すると便利
仕分けルール（例）
