FAX受信してメール転送（VBS）

はじめに

受信したFAXを外出先で確認出来たら、わざわざ事務所へ行かなくても内容が確認出来て素早い対応が可能となります。問題は全てのFAXがその機能を持ち合わせていない事です。

今回は”EPSON PX-1700F”を利用して受信内容をメール転送したいと思います。

PX-1700Fでは、受信したFAXを印刷するかパソコンの任意のフォルダに保存する機能（PC-FAX受信）がありますのでこれを利用します。保存された文書はPDF形式となりますので、スマートフォンなどでもメール受信出来れば内容を確認することが出来ます。

保存された文書を定期的にチェックしてPDFファイルがあった場合にメールの添付ファイルとして送信するVBスクリプトを作成します。

追加機器などが不要なため費用をかけずに、ちょっとした手間で実現可能です。

　動作確認　　Windows10　64ビット　EPSON PX-1700F

必要な作業

受信FAXをコンピュータへ保存する設定
VBスクリプトの準備
バッチファイルの準備
タスクスケジューラの準備

１．受信FAXをコンピュータへ保存する設定

コンピュータへ保存する設定は、EPSON SoftwareのFAX Utilityを使って行います。

※FAX Utilityのインストールについては、プリンタに添付のマニュアルを参照ください。ドライバファイルは、EPSONのサイトから入手できます。

EPSON SoftwareのFAX Utilityを実行します。

※Windowsキーを押して、faxと入力して表示される FAX Utility を起動でOK

受信ファクスをこのコンピュータへ保存するをクリックします。

受信ファクスをこのコンピュータへ保存する（PC-FAX受信）の下にあるラジオボタンをオンにチェックします。

保存フォルダーは任意のフォルダでOKですが、上記では「D:\FAX」としています。

※フォルダはあらかじめ容易しておく必要があります。

新着確認の間隔と新着の通知は、お好みorそのままで「OK」ボタンを押します。

※受信ファクスをこのコンピューターへ保存する設定を行った場合、印刷されなくなりますのでご注意ください。ペーパーレスやインクの節約には貢献できます。

２．VBスクリプトの準備

以下のコードをコピーしてパソコンに保存します。※文字コードは「Shift-JIS」で、ファイル名は「FaxMail_sjis.vbs」として任意のフォルダ（例　D:\Bat）に保存します。

Option Explicit

Dim objMessage
Dim mySMTPServer
Dim mySMTPPort
Dim MailFrom
Dim MailFromPass
Dim MailTo
Dim MailCc
Dim MailBcc
Dim Title
Dim TxtBodyFile
Dim TxtBody
Dim myAttachment
Dim folderPath
Dim bakFolderPath
Dim objFS
Dim objFolder
Dim objFile

' --------------------------------------------------
' 変数定義
' --------------------------------------------------
mySMTPServer = "サーバのアドレス"
mySMTPPort = 587
MailFrom = "送信者メールアドレス"
MailFromPass = "送信者メールアドレスのパスワード"
MailTo = "受信者メールアドレス"
'MailCc = "受信者メールアドレス"
MailBcc = "受信者メールアドレス"
Title = "FAX受信"
TxtBody = "FAXが届きました。"		'' メール本文
' 添付ファイル
folderPath = "D:\FAX\"
bakFolderPath = "D:\FAX\bak\"

' --------------------------------------------------
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFS.GetFolder(folderPath)

If objFolder.Files.Count > 0 Then
	For Each objFile In objFolder.Files
		'' 添付ファイル名
		myAttachment = folderPath & objFile.Name
		WScript.Echo myAttachment
		'' メール送信
		Set objMessage = Nothing
		Set objMessage = CreateObject("CDO.Message")
		objMessage.From = MailFrom
		objMessage.To = MailTo
		'objMessage.Cc = MailCc
		objMessage.Cc = MailBcc
		objMessage.Subject = Title
		objMessage.TextBody = TxtBody
		objMessage.AddAttachment(myAttachment)
		objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
		objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = mySMTPServer
		objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = mySMTPPort
		objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
		objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = MailFrom
		objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = MailFromPass
		objMessage.Configuration.Fields.Update
		objMessage.Send
		'' 5秒待機
		WScript.Sleep 5000
	Next

	'' ファイル移動
	objFS.MoveFile folderPath & "*.pdf", bakFolderPath
End If

Set objMessage = Nothing
Set myAttachment = Nothing
Set objFile = Nothing
Set objFolder = Nothing
Set objFS = Nothing

Option Explicit

Dim objMessage

Dim mySMTPServer

Dim mySMTPPort

Dim MailFrom

Dim MailFromPass

Dim MailTo

Dim MailCc

Dim MailBcc

Dim Title

Dim TxtBodyFile

Dim TxtBody

Dim myAttachment

Dim folderPath

Dim bakFolderPath

Dim objFS

Dim objFolder

Dim objFile

' --------------------------------------------------

' 変数定義

' --------------------------------------------------

mySMTPServer = "サーバのアドレス"

mySMTPPort = 587

MailFrom = "送信者メールアドレス"

MailFromPass = "送信者メールアドレスのパスワード"

MailTo = "受信者メールアドレス"

'MailCc = "受信者メールアドレス"

MailBcc = "受信者メールアドレス"

Title = "FAX受信"

TxtBody = "FAXが届きました。" '' メール本文

' 添付ファイル

folderPath = "D:\FAX\"

bakFolderPath = "D:\FAX\bak\"

' --------------------------------------------------

Set objFS = CreateObject("Scripting.FileSystemObject")

Set objFolder = objFS.GetFolder(folderPath)

If objFolder.Files.Count > 0 Then

For Each objFile In objFolder.Files

'' 添付ファイル名

myAttachment = folderPath & objFile.Name

WScript.Echo myAttachment

'' メール送信

Set objMessage = Nothing

Set objMessage = CreateObject("CDO.Message")

objMessage.From = MailFrom

objMessage.To = MailTo

'objMessage.Cc = MailCc

objMessage.Cc = MailBcc

objMessage.Subject = Title

objMessage.TextBody = TxtBody

objMessage.AddAttachment(myAttachment)

objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = mySMTPServer

objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = mySMTPPort

objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1

objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = MailFrom

objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = MailFromPass

objMessage.Configuration.Fields.Update

objMessage.Send

'' 5秒待機

WScript.Sleep 5000

'' ファイル移動

objFS.MoveFile folderPath & "*.pdf", bakFolderPath

End If

Set objMessage = Nothing

Set myAttachment = Nothing

Set objFile = Nothing

Set objFolder = Nothing

Set objFS = Nothing

変数定義部分を編集します

' --------------------------------------------------
 ' 変数定義
 ' --------------------------------------------------
 mySMTPServer = "サーバのアドレス"
 mySMTPPort = 587
 MailFrom = "送信者メールアドレス"
 MailFromPass = " 送信者メールアドレスパスワード"
 MailTo = "受信者メールアドレス"
 'MailCc = "受信者メールアドレス"
 MailBcc = "受信者メールアドレス"
 Title = "FAX受信"
 TxtBody = "FAXが届きました。"        '' メール本文
 ' 添付ファイル
 folderPath = "D:\FAX\"
 bakFolderPath = "D:\FAX\bak\"

' --------------------------------------------------

' 変数定義

' --------------------------------------------------

mySMTPServer = "サーバのアドレス"

mySMTPPort = 587

MailFrom = "送信者メールアドレス"

MailFromPass = " 送信者メールアドレスパスワード"

MailTo = "受信者メールアドレス"

'MailCc = "受信者メールアドレス"

MailBcc = "受信者メールアドレス"

Title = "FAX受信"

TxtBody = "FAXが届きました。" '' メール本文

' 添付ファイル

folderPath = "D:\FAX\"

bakFolderPath = "D:\FAX\bak\"

folderPath は、上記１で設定したフォルダを設定します。

bakFolderPathは、メール転送後に移動するフォルダを設定します。フォルダを作成しておいてください。

ちょこっと解説

・folderPathで設定したフォルダにFAX受信PDFファイルが存在する場合にPDFファイル１件につきメールを１通送ります。

・メール送信には、CDO.Messageを利用します。

・すべてのメール送信が完了したらfolderPathに存在するPDFファイルをbakFolderPathフォルダへ移動して終了します。

３．バッチファイルの準備

以下のコードをコピーしてパソコンに保存します。※ファイル名は「FaxMail.bat」としてVBスクリプトと同じフォルダに保存します。

@echo off
 d:
 cd \Bat
 cscript FaxMail_sjis.vbs
 cd \

@echo off

cd \Bat

cscript FaxMail_sjis.vbs

cd \

このバッチファイルはVBスクリプトをタスクスケジューラに登録する際に利用します。

このバッチファイルを実行すると動作確認ができますので、FAX受信のフォルダに適当なPDFファイルを格納してからこのバッチファイルを実行しメールが送られてくるか確認してください。また、メール送信後にbakFolderPathへ移動されるかも確認してください。

★ここの動作確認で問題が無かった場合に限り、次以降の作業を実施ください。

４．タスクスケジューラの準備

Windowsのタスクスケジューラに３で登録したバッチファイルを登録します。

１．Windowsキーを押してtaと入力し「タスクスケジューラ」を実行します。

２．左側の「タスクスケジューラ　ライブラリ」をクリック

３．右側の「タスクの作成」をクリック

・名前に、FaxMailと入力します。

・ユーザーがログオンしているかどうかにかかわらず実行するをチェック

４．「トリガー」タブをクリックします。

５．「新規」ボタンを押します。

・繰り返し間隔にチェックを入れて間隔を選択します。

・継続時間を無制限にします。

「OK」ボタンを押します。

６．「操作」タブをクリックします。

７．「新規」ボタンをクリックします。

・プログラム/スクリプトに３のバッチファイルを指定します。

「OK」ボタンをクリックします。

「OK」ボタンをクリックしてタスクの作成を完了します。

これで定期的に処理が実行されますので、パソコンは24時間起動しておく必要があります。※パソコンはスリープ状態やシャットダウンされることが無いようにしておいてください。

終わりに

今回の仕組みはFAXの受信量が少ない場合にはそのまま運用できると思いますが、まだまだ改良の余地がありますので実運用には十分に検証を行ってください。間違いがあった場合にはお知らせいただけると幸いです。

例えば、メール転送したPDFファイルを完了後に別フォルダへ移動しますので、処理中にFAX受信したらタイミングによってどうなるのか未検証です。対策としては、メール転送したファイルを保持しておき、このファイルだけを移動させることや、ファイル属性のアーカイブビットを利用するなどが考えられます。

スクリプトの実行等については、自己責任でよろしくお願いします。