<?xml version="1.0" encoding="utf-8" ?>
<rss version="2.0" xmlns:atom="http://www.w3.org/2005/Atom">
<channel>
<title>orangehelloのブログ</title>
<link>https://ameblo.jp/orangehello/</link>
<atom:link href="https://rssblog.ameba.jp/orangehello/rss20.xml" rel="self" type="application/rss+xml" />
<atom:link rel="hub" href="http://pubsubhubbub.appspot.com" />
<description>ブログの説明を入力します。</description>
<language>ja</language>
<item>
<title>Excelのvbaを使用したyahooメールの送信（BASP21)</title>
<description>
<![CDATA[ <p>PCのメモ帳に書いた内容を携帯電話などの送りたいことはありませんか。</p><br><p>私は週１回程度は送っていて、送る手間が面倒だったのでvbaですぐ送れるようにしました。</p><br><p>今まで</p><p>yahooメールにログイン → メール作成ボタン → 宛先貼り付け → 件名・本文貼り付け → 送信</p><br><p>vbaでメール送信ツール作成後</p><p>メモ帳に件名・本文貼り付け → vbsをダブルクリック</p><br><p>このように使用しない方も参考になればと思います。</p><br><br><br><p>～作成方法～</p><p>１、BASP21をインストールする</p><p><a href="http://www.hi-ho.ne.jp/~babaq/basp21.html">http://www.hi-ho.ne.jp/~babaq/basp21.html</a> 　をクリック</p><br><p>最新版のexe（実行用）とlzh（更新用）をダウンロードします。</p><br><br><br><div align="center"><a href="http://stat.ameba.jp/user_images/20141210/16/orangehello/a3/aa/p/o0800027213154879690.png"><img style="FLOAT: left; CLEAR: both" border="0" alt="" src="https://stat.ameba.jp/user_images/20141210/16/orangehello/a3/aa/p/t02200075_0800027213154879690.png" width="220" height="75"></a></div><p><br><br><br><br><br></p><br><p>2014/12/10では上図で赤に囲まれた部分が最新版のexeとlzh</p><br><p>BASP21-2003-0211.exeを実行するとインストールされます。</p><br><p>次にBsmtp20070629-587.lzhを解凍すると</p><p>・Bsendm.exe<br>・Bsmtp.dll</p><p>のファイルが作成されます。</p><p>この２つを C:\Windows\System32 配下にコピーして上書き保存します。</p><p><br>これでBASP21の準備は完了です。</p><br><br><br><p>２、VBAでBASP21を参照設定する</p><p><a href="http://stat.ameba.jp/user_images/20141210/16/orangehello/2f/02/p/o0713027513154891247.png"><img border="0" alt="" src="https://stat.ameba.jp/user_images/20141210/16/orangehello/2f/02/p/t02200085_0713027513154891247.png" width="220" height="85"></a></p><br><p><br><a href="http://stat.ameba.jp/user_images/20141210/17/orangehello/85/6f/p/o0469032313154904146.png"><img style="FLOAT: left; CLEAR: both" border="0" alt="" src="https://stat.ameba.jp/user_images/20141210/17/orangehello/85/6f/p/t02200152_0469032313154904146.png" width="220" height="152"></a><br><br><br><br><br></p><br><br><br><br><br><br><br><p>VBE上の[ツール] - [参照設定] - [BASP21 1.0 Type Library] にチェックを入れます。</p><br><br><p><br>３、VBAを作成とメール送信</p><br><p>以下VBAサンプルの*****を適切に変更し、実行してください。</p><p>また私の環境では送信できることを確認済みです。</p><br><p>Sub mail()<br>    Dim bobj As Object<br>    Dim svname As String<br>    Dim id As String<br>    Dim pass As String<br>    Dim msg As Variant '送信チェック用<br>    <br>    Dim strMLadr As String<br>    Dim strDPadr As String<br>    Dim strPW As String<br>    <br>    'SMTPサーバ名:ポート番号:タイムアウト秒<br>    svname = "smtp.mail.yahoo.co.jp:587:60"  'yahoo用SMTP<br>    <br>    'ログインID(yahooのID)<br>    id = "*******"<br>    <br>    'オブジェクトを作成<br>    Set bobj = CreateObject("basp21")<br>    <br>    '宛先<br>    Mailto = "<a href="mailto:***********************@ezweb.ne.jp">***********************@ezweb.ne.jp</a>"<br>    <br>    '送信者<br>    strMLadr = "<a href="mailto:**************@yahoo.co.jp">**************@yahoo.co.jp</a>" '（送信者のメールアドレス<br>    strDPadr = "VBAメール送信ツール" '（送信者の表示文字列）<br>    strPW = "*******" '（送信者メールアドレスのパスワード）<br>    MailFrom = strDPadr &amp; "&lt;" &amp; strMLadr &amp; "&gt;" &amp; vbTab &amp; id &amp; ":" &amp; strPW<br>    <br>    '件名<br>    subj = "送信テスト"<br>    <br>    '本文　改行はvbCrLf<br>    Body = "おめでとうございます。" &amp; vbCrLf &amp; "送信できました。"<br>    'メール送信<br>    msg = bobj.SendMail(svname, Mailto, MailFrom, subj, Body, "")<br>    <br>    ' 送信チェック<br>    If msg &lt;&gt; "" Then<br>        MsgBox "送信できませんでした。" &amp; vbCrLf &amp; msg, vbOKOnly + vbCritical, "エラー"<br>    Else<br>        MsgBox "送信に成功しました。", vbOKOnly + vbInformation, "完了"<br>    End If<br>End Sub</p><br><br><p>４、VBSからVBAを実行してメール送信（</p><p>以下VBAサンプルです。</p><p><br>Sub mail2()<br>    Dim writebody<br>    writebody = ""<br>    Dim buf As String<br>    Dim writesubj<br>    '本文用メモ帳のパス<br>    Open "*****" For Input As #1<br>    '件名用メモ帳のパス<br>    Open "*****" For Input As #2<br>        Do Until EOF(1)<br>            Line Input #1, buf<br>            writebody = writebody + buf + vbCrLf<br>        Loop<br>        Line Input #2, buf<br>        writesubj = buf<br>    Close #1<br>    Close #2<br>    <br>    Dim bobj As Object<br>    Dim svname As String<br>    Dim id As String<br>    Dim pass As String<br>    Dim msg As Variant '送信チェック用<br>    <br>    Dim strMLadr As String<br>    Dim strDPadr As String<br>    Dim strPW As String<br>    <br>    'SMTPサーバ名:ポート番号:タイムアウト秒<br>    svname = "smtp.mail.yahoo.co.jp:587:60"  '←yahoo用<br>    <br>    'ログインID<br>    id = "iamokamura"<br>    <br>    'オブジェクトを作成<br>    Set bobj = CreateObject("basp21")<br>    <br>    '宛先<br>    Mailto = "<a href="mailto:**************@ezweb.ne.jp">**************@ezweb.ne.jp</a>"<br>    <br>    '送信者<br>    strMLadr = "<a href="mailto:***********@yahoo.co.jp">***********@yahoo.co.jp</a>" '（送信者のメールアドレス'<br>    strDPadr = "vbsメール送信ツール" '（送信者の表示文字列）<br>    strPW = "*****" '（送信者メールアドレスのパスワード）<br>    MailFrom = strDPadr &amp; "&lt;" &amp; strMLadr &amp; "&gt;" &amp; vbTab &amp; id &amp; ":" &amp; strPW<br>    <br>    <br>    '本文　<br>    Body = writebody<br>    '件名<br>    subj = writesubj<br>    'メール送信<br>    msg = bobj.SendMail(svname, Mailto, MailFrom, subj, Body, "")<br>    <br>    ' 送信チェック<br>    If msg &lt;&gt; "" Then<br>        MsgBox "送信できませんでした。" &amp; vbCrLf &amp; msg, vbOKOnly + vbCritical, "エラー"<br>    Else<br>        MsgBox "送信に成功しました。", vbOKOnly + vbInformation, "完了"<br>    End If<br>End Sub<br></p><br><br><p>以下VBSサンプルです。例外処理を組んでいます。*****.vbsで保存してください。</p><br><p>'エラー処理を有効<br>On Error Resume Next</p><p>Dim excelApp : Set excelApp = CreateObject("Excel.Application")<br>' Excelを非表示にする<br>excelApp.Visible = False</p><p>'VBAのパス</p><p>Dim targetFile : targetFile = "***********"<br>'マクロの名前</p><p>Dim targetMacro : targetMacro = "*******" '例：sendmail.xlsm!Sheet1.mail</p><p>' Excelファイルを開く<br>excelApp.Workbooks.Open targetFile<br>' マクロの実行<br>excelApp.Run targetMacro</p><p>Dim strErrMsg</p><p>'エラーが起きたとき<br>If Err.Number &lt;&gt; 0 Then<br> msgbox "例外処理エラーです:"&amp; Err.Description<br>End If<br>' Excelの終了<br>excelApp.Quit<br>WScript.sleep(2000)<br>'エクセルオブジェクトの破棄<br>Set excelApp = Nothing<br>' Excelを表示にする<br>excelApp.Visible = true<br>'エラーをクリア<br>Err.Clear<br>'エラー処理を無効<br>On Error Goto 0</p><br><br><br><br><br>
]]>
</description>
<link>https://ameblo.jp/orangehello/entry-11962959570.html</link>
<pubDate>Wed, 10 Dec 2014 16:26:33 +0900</pubDate>
</item>
</channel>
</rss>
