| |
「添付ファイル付きメールの送信」に関する質問と解釈して回答します。
１．改行については、「&」で vbCrLfを文字列に継ぎ足すことで可能。
２．確認メッセージなしの送信について・・・
私の環境のExcel 2002では、条件付きで可能であることを確認しております。
あーりん様のExcelのバージョンでは、動作するでしょうか？
動作する条件に関しては、下記マクロの『注記』を御覧ください。
注記2.の「Microsoft Outlookが起動済みの状態・・・」ですが、
会社などでパソコンを使う場合、大抵はWindows起動と同時にOutlookを起動し、
メール受信待ちのため、Outlookのウィンドウを最小化していると思いますので、
この状態で即時に送信可能という意味です。
（無論、通常表示・最大表示でも即時に送信可能）
Sub MyXlMailAtt()
Rem *----*----* *----*----* *----*----* *----*----*
Rem Excelブック添付ファイルOutlook電子メール送信処理
Rem 言語：Excel VBA
Rem 機能...
Rem 開いているExcelのブックを電子メールの添付ファイルとして送信する。
Rem 注記...
Rem 1. Microsoft Outlook上で、下記の手作業による事前設定が必要。
Rem Microsoft Outlookのメニューバーの[ツール]から[オプション...]をクリックし、
Rem [メール形式]タブの[電子メールの編集にMicrosoft Wordを使用する]チェックボックスを
Rem オンにする。（既定値）
Rem 2. Microsoft Outlookが起動済みの状態である場合、すぐに電子メールが送信される。
Rem 起動してない場合は、これを起動して[送受信]ボタンを押して送信する必要がある。
Rem 3. [電子メールの編集にMicrosoft Wordを使用する]場合、警告なしに送信する。
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 myWinState As String
Dim myWord As Variant ' Word.Application
Dim myCmmdBar As CommandBar
Dim myCtrl As CommandBarControl
Rem *----*----* *----*----* *----*----* *----*----*
'
Select Case True
Case Len(ActiveWorkbook.Path) = 0
MsgBox "新規作成のブックです。" & vbCrLf _
& "一旦、名前を付けて保存して下さい。", vbCritical + vbOKOnly, "MyXlMailAtt"
Exit Sub
Case ActiveWorkbook.Saved = False
MsgBox "ブックが更新されています。" & vbCrLf _
& "一旦、上書き保存して下さい。", vbCritical + vbOKOnly, "MyXlMailAtt"
Exit Sub
End Select
Rem *----*----* *----*----* *----*----* *----*----*
'
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
.Subject = "このメールはテストです。"
.To = "xxxxxxxxx@xxx.com"
.BCC = "xxxxxx@xxxx.ne.jp"
.FlagRequest = "凄い！"
.Importance = 2 ' = olImportanceHigh
Rem 0 = olImportanceLow / 1 = olImportanceNormal
Rem メッセージ形式...
Rem テキスト形式の場合、書式設定（文字色・蛍光ペン書式など）は無効になる。
.BodyFormat = 1 ' = olFormatPlain / 2 = olFormatHTML
.Attachments.Add ActiveWorkbook.FullName
.Body = "sss" & vbCrLf & "添付ファイルを送付します。" & vbCrLf & "ttt"
.Display
End With
Rem *----*----* *----*----* *----*----* *----*----*
'
On Error Resume Next
Set myWord = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Rem [電子メールの編集にMicrosoft Wordを使用する]でない場合
Rem [送信]ボタンを表示させる。
MyOutlook.ActiveInspector.CommandBars("Standard").Visible = True
Rem MsgBox表示のため、開いているシートをアクティブ状態にする。（苦肉の策）
AppActivate Application.Caption
MsgBox "[送信]ボタンを押して下さい。", vbMsgBoxSetForeground, "MyXlMailAtt"
MyOutlook.ActiveInspector.Activate
GoTo MyXlMailAttSubExit
End If
On Error GoTo 0
'
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
' .Visible = True
.Caption = "送信"
.DescriptionText = "電子メールの送信コマンドを実行します。"
.Execute
End With
End With
Rem *----*----* *----*----* *----*----* *----*----*
'
MyXlMailAttSubExit:
Set MyOutlook = Nothing
Set MyMail = Nothing
Set myWord = Nothing
Set myCmmdBar = Nothing
Set myCtrl = Nothing
End Sub ' MyXlMailAtt *----*----* *----*----* *----*----* *----*----*
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
