PCのメモ帳に書いた内容を携帯電話などの送りたいことはありませんか。
私は週１回程度は送っていて、送る手間が面倒だったのでvbaですぐ送れるようにしました。
今まで
yahooメールにログイン → メール作成ボタン → 宛先貼り付け → 件名・本文貼り付け → 送信
vbaでメール送信ツール作成後
メモ帳に件名・本文貼り付け → vbsをダブルクリック
このように使用しない方も参考になればと思います。
～作成方法～
１、BASP21をインストールする
http://www.hi-ho.ne.jp/~babaq/basp21.html をクリック
最新版のexe（実行用）とlzh（更新用）をダウンロードします。
2014/12/10では上図で赤に囲まれた部分が最新版のexeとlzh
BASP21-2003-0211.exeを実行するとインストールされます。
次にBsmtp20070629-587.lzhを解凍すると
・Bsendm.exe
・Bsmtp.dll
のファイルが作成されます。
この２つを C:\Windows\System32 配下にコピーして上書き保存します。
これでBASP21の準備は完了です。
２、VBAでBASP21を参照設定する
VBE上の[ツール] - [参照設定] - [BASP21 1.0 Type Library] にチェックを入れます。
３、VBAを作成とメール送信
以下VBAサンプルの*****を適切に変更し、実行してください。
また私の環境では送信できることを確認済みです。
Sub mail()
Dim bobj As Object
Dim svname As String
Dim id As String
Dim pass As String
Dim msg As Variant '送信チェック用
Dim strMLadr As String
Dim strDPadr As String
Dim strPW As String
'SMTPサーバ名:ポート番号:タイムアウト秒
svname = "smtp.mail.yahoo.co.jp:587:60" 'yahoo用SMTP
'ログインID(yahooのID)
id = "*******"
'オブジェクトを作成
Set bobj = CreateObject("basp21")
'宛先
Mailto = "***********************@ezweb.ne.jp
"
'送信者
strMLadr = "**************@yahoo.co.jp
" '（送信者のメールアドレス
strDPadr = "VBAメール送信ツール" '（送信者の表示文字列）
strPW = "*******" '（送信者メールアドレスのパスワード）
MailFrom = strDPadr & "<" & strMLadr & ">" & vbTab & id & ":" & strPW
'件名
subj = "送信テスト"
'本文 改行はvbCrLf
Body = "おめでとうございます。" & vbCrLf & "送信できました。"
'メール送信
msg = bobj.SendMail(svname, Mailto, MailFrom, subj, Body, "")
' 送信チェック
If msg <> "" Then
MsgBox "送信できませんでした。" & vbCrLf & msg, vbOKOnly + vbCritical, "エラー"
Else
MsgBox "送信に成功しました。", vbOKOnly + vbInformation, "完了"
End If
End Sub
４、VBSからVBAを実行してメール送信（
以下VBAサンプルです。
Sub mail2()
Dim writebody
writebody = ""
Dim buf As String
Dim writesubj
'本文用メモ帳のパス
Open "*****" For Input As #1
'件名用メモ帳のパス
Open "*****" For Input As #2
Do Until EOF(1)
Line Input #1, buf
writebody = writebody + buf + vbCrLf
Loop
Line Input #2, buf
writesubj = buf
Close #1
Close #2
Dim bobj As Object
Dim svname As String
Dim id As String
Dim pass As String
Dim msg As Variant '送信チェック用
Dim strMLadr As String
Dim strDPadr As String
Dim strPW As String
'SMTPサーバ名:ポート番号:タイムアウト秒
svname = "smtp.mail.yahoo.co.jp:587:60" '←yahoo用
'ログインID
id = "iamokamura"
'オブジェクトを作成
Set bobj = CreateObject("basp21")
'宛先
Mailto = "**************@ezweb.ne.jp
"
'送信者
strMLadr = "***********@yahoo.co.jp
" '（送信者のメールアドレス'
strDPadr = "vbsメール送信ツール" '（送信者の表示文字列）
strPW = "*****" '（送信者メールアドレスのパスワード）
MailFrom = strDPadr & "<" & strMLadr & ">" & vbTab & id & ":" & strPW
'本文
Body = writebody
'件名
subj = writesubj
'メール送信
msg = bobj.SendMail(svname, Mailto, MailFrom, subj, Body, "")
' 送信チェック
If msg <> "" Then
MsgBox "送信できませんでした。" & vbCrLf & msg, vbOKOnly + vbCritical, "エラー"
Else
MsgBox "送信に成功しました。", vbOKOnly + vbInformation, "完了"
End If
End Sub
以下VBSサンプルです。例外処理を組んでいます。*****.vbsで保存してください。
'エラー処理を有効
On Error Resume Next
Dim excelApp : Set excelApp = CreateObject("Excel.Application")
' Excelを非表示にする
excelApp.Visible = False
'VBAのパス
Dim targetFile : targetFile = "***********"
'マクロの名前
Dim targetMacro : targetMacro = "*******" '例：sendmail.xlsm!Sheet1.mail
' Excelファイルを開く
excelApp.Workbooks.Open targetFile
' マクロの実行
excelApp.Run targetMacro
Dim strErrMsg
'エラーが起きたとき
If Err.Number <> 0 Then
msgbox "例外処理エラーです:"& Err.Description
End If
' Excelの終了
excelApp.Quit
WScript.sleep(2000)
'エクセルオブジェクトの破棄
Set excelApp = Nothing
' Excelを表示にする
excelApp.Visible = true
'エラーをクリア
Err.Clear
'エラー処理を無効
On Error Goto 0