| |
▼H. C. Shinopy さん：
ありがとうございます。
早速試してみます。
取り急ぎ、お礼申し上げます。
>>下記のマクロは開いたシートのデータを本文に貼り付けて送信する処理です。
添付ファイルでは、
>Office XP（Word / Excel / Outlook 2002）で動作を確認しましたが、
>2000あるいは2003では動作するかどうか判りません。
>（このマクロは参照設定なしでも動作するようにしています。）
>
>Sub MyXlMail()
> Rem *----*----* *----*----* *----*----* *----*----*
> Rem Excelシートデータ電子メール送信処理
> Rem 言語：Excel VBA
> Rem 機能...
> Rem Excelのシート上にあるデータをコピーして、
> Rem 電子メールの本文に貼り付け送信する。
> Rem 注記...
> Rem 1. Microsoft Outlookで[電子メールの編集にMicrosoft Wordを使用する]を指定しておくこと。
> Rem Microsoft Outlookのメニューバーの[ツール]から[オプション...]をクリックし、
> Rem [メール形式]タブの[電子メールの編集にMicrosoft Wordを使用する]チェックボックスを
> Rem オンにする。
> Rem 2. Microsoft Wordの標準コマンドバーに<送信>コマンドボタンを追加しておくこと。
> Rem Microsoft Wordのメニューバーの[ツール]から[ユーザー設定...]をクリックし、
> Rem [ユーザー設定]ダイアログボックスから[コマンド]タブを選択し、
> Rem [分類]の[すべてのコマンド]を選択して、[コマンド]の[EmailSend]を
> Rem <標準>コマンドバーにドラッグし、<送信>コマンドボタンを追加する。
> Rem 3. Microsoft Outlookが起動している場合、すぐに電子メールが送信される。
> Rem 起動してない場合は、これを起動して[送受信]ボタンを押して送信する必要がある。
> Rem 4. 警告なしに送信する。
> Rem 履歴...
> Rem 第1版：2006/06/05：作成。
> 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
> Dim myCmmdBar As CommandBar
> Dim myCtrl As CommandBarControl
> '
> 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)
> Rem ↓なぜか、本文の末尾に件名の文字が挿入されるため、3文字の空白を件名の先頭に付ける。
> myMail.Subject = " " & "このメールはテストです。"
> myMail.To = "xxxxxx@msn.com"
> myMail.BCC = "xxxxxx@xxxx.ne.jp"
> myMail.Body = "下記の通り、お知らせ致します。" & vbCrLf & vbCrLf
> myMail.FlagRequest = "凄い！"
> myMail.Importance = 2 ' = olImportanceHigh
> Rem olImportanceHigh olImportanceLow olImportanceNormal
> myMail.Display
> '
> Set myWord = GetObject(, "Word.Application")
> myWord.Selection.EndKey Unit:=6, Extend:=0 ' Unit:=wdStory, Extend:=wdMoveEnd
> myWord.Selection.Paste
> '
> Application.CutCopyMode = False
> Range("A1").Select
> '
> Set myCmmdBar = myWord.CommandBars("Standard") ' 標準
> Set myCtrl = myCmmdBar.FindControl(ID:=3708) ' 送信 ' WordBasic.EmailSend
> myCtrl.Execute
> '
> Set myOutlook = Nothing
> Set myMail = Nothing
> Set myWord = Nothing
> Set myCmmdBar = Nothing
> Set myCtrl = Nothing
>End Sub ' MyXlMail *----*----* *----*----* *----*----* *----*----*
|
|
いつも
- 06/6/6(火) 11:32 -
