Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


18897 / 76732 ←次へ | 前へ→

【63273】Re:VBA メール自動送信でOutlookの警告が出てしまいます
回答  H. C. Shinopy  - 09/10/21(水) 21:47 -

引用なし
パスワード
   Excel 2007の場合、MailItem オブジェクト.Sendで送信できました。
2002の場合(2003は不明)、注記の条件下で、裏で動いているWordを「GetObject(, "Word.Application")」で拾ってきて、Wordの[送信]ボタンを押すことで送信できます。
(しかし、私のかつての環境では、「本文の末尾に件名の頭3文字が挿入される」珍現象が出ました。)
いずれも随分前の話で、今の私の環境ではテストできないので、動作の保証はできません。
(最下段のマクロ)

また、O'REILLY(オライリー)社の「EXCEL HACKS 第2版」の「HACK140」362頁に下の記述がありました。
「…このようなダイアログボックスが表示されないようにするためのツールがいくつか公開されています。
Express ClickYes(ht tp://www.contextmagic.com/express-clickyes/)」はフリーで利用できます。
VBAのコードの中から設定したい場合は、商用のOutlook Redemption(ht tp://www.dimastr.com/redemption/)を使うとよいでしょう。」

Sub MyXlMail()
 Rem *----*----*  *----*----*  *----*----*  *----*----*
 Rem ExcelシートデータOutlook電子メール送信処理
 Rem 言語:Excel VBA
 Rem 機能...
 Rem  Excelのシート上にあるデータをコピーして、
 Rem  電子メールの本文に貼り付け送信する。
 Rem 注記...
 Rem  1. Microsoft Outlook(〜2003)上で、下記の手作業による事前設定が必要。
 Rem   Microsoft Outlookのメニューバーの[ツール]から[オプション...]をクリックし、
 Rem   [メール形式]タブの[電子メールの編集にMicrosoft Wordを使用する]チェックボックスを
 Rem   オンにする。
 Rem  2. Microsoft Outlookが起動済みの状態である場合、すぐに電子メールが送信される。
 Rem   起動してない場合は、これを起動して[送受信]ボタンを押して送信する必要がある。
 Rem  3. 警告なしに送信する。
 Rem  4. 不具合あり。
 Rem   Office2007ではExcelシート上のデータを表形式で送信することができない。
 Rem 履歴...
 Rem  第1版:2006/06/05:作成。
 Rem  第5版:2008/08/12:Microsoft Outlookのバージョンにより送信する処理方法を分けた。
 Rem *----*----*  *----*----*  *----*----*  *----*----*
 Rem 参照設定する場合...
 Rem  Microsoft Outlook 10.0 Object Library
 Rem  Microsoft Word 10.0 Object Library
 Rem *----*----*  *----*----*  *----*----*  *----*----*
 Dim myOutlook As Variant ' Outlook.Application
 Dim myMail As Variant ' MailItem
 Dim myWord As Variant ' Word.Application
 Dim myCmmdBar As CommandBar
 Dim myCtrl As CommandBarControl
 Rem *----*----*  *----*----*  *----*----*  *----*----*
 '
 ActiveSheet.UsedRange.Select
 Selection.Copy
 '
 On Error Resume Next
 Set myOutlook = GetObject(, "Outlook.Application")
 If Err.Number <> 0 Then
  Set myOutlook = CreateObject("Outlook.Application")
 End If
 On Error GoTo 0
 '
 Set myMail = myOutlook.CreateItem(0) ' = myOutlook.CreateItem(olMailItem)
 With myMail
  Rem ↓なぜか、本文の末尾に件名の頭3文字が挿入されるため、3文字の空白を件名の先頭に付ける。
  .Subject = "  " & "このメールはテストです。"
  .VotingOptions "はい!;いいえ!"
  .To = "xxxxxxx@msn.com";
  .BCC = "xxxxxx@xxxx.ne.jp";
  .Body = "下記の通り、お知らせ致します。" & vbCrLf & vbCrLf
  .FlagRequest = "酷い!"
  .Importance = 2 ' = olImportanceHigh
  Rem  0 = olImportanceLow / 1 = olImportanceNormal
  Rem メッセージ形式...
  Rem テキスト形式の場合、書式設定(文字色・蛍光ペン書式など)は無効になる。
  .BodyFormat = 2 ' 1 ' = olFormatPlain / 2 = olFormatHTML
  .Display
 End With
 '
 On Error Resume Next
 Set myWord = GetObject(, "Word.Application")
 If Err.Number <> 0 Then
  Set myWord = CreateObject("Word.Application")
  myWord.Visible = True
  myWord.Documents.Add
 End If
 On Error GoTo 0
 myWord.Selection.EndKey Unit:=6, Extend:=0 ' Unit:=wdStory, Extend:=wdMoveEnd
 On Error Resume Next ' シートに何も入力されていない場合に対処。
 myWord.Selection.Paste
 myWord.Selection.WholeStory
 On Error GoTo 0
 '
 Application.CutCopyMode = False
 Range("A1").Select
 Rem *----*----*  *----*----*  *----*----*  *----*----*
 '
 If Val(myOutlook.Version) >= 12 Then
  With myMail
   .Body = .Body & myWord.Selection.Range.FormattedText ' myWord.ActiveDocument.Content ' myWord.Selection.FormattedText
   .Send
  End With
  myWord.Documents.Close SaveChanges:=0 ' wdDoNotSaveChanges
  myWord.Quit
 Else
  On Error Resume Next
  myWord.CommandBars("Zzz").Delete
  On Error GoTo 0
  '
  Set myCmmdBar = myWord.CommandBars.Add(Name:="Zzz", Position:=msoBarPopup, Temporary:=True)
  With myCmmdBar.Controls
   Set myCtrl = .Add(Type:=msoControlButton, ID:=3708)
   With myCtrl
    .Caption = "送信"
    .DescriptionText = "電子メールの送信コマンドを実行します。"
    .Execute
   End With
  End With
  myCmmdBar.Delete
 End If
 Rem *----*----*  *----*----*  *----*----*  *----*----*
 '
 Set myOutlook = Nothing
 Set myMail = Nothing
 Set myWord = Nothing
 Set myCmmdBar = Nothing
 Set myCtrl = Nothing
End Sub ' MyXlMail *----*----*  *----*----*  *----*----*  *----*----*
1 hits

【63270】VBA メール自動送信でOutlookの警告が出てしまいます 09/10/21(水) 16:16 質問
【63273】Re:VBA メール自動送信でOutlookの警告... H. C. Shinopy 09/10/21(水) 21:47 回答
【63279】Re:VBA メール自動送信でOutlookの警告... 09/10/22(木) 14:30 質問
【63282】Re:VBA メール自動送信でOutlookの警告... H. C. Shinopy 09/10/22(木) 20:20 回答
【63287】Re:VBA メール自動送信でOutlookの警告... 09/10/23(金) 9:18 お礼

18897 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free