Sub MyXlMailAtt()
  Rem *----*----*    *----*----*    *----*----*    *----*----*
  Rem Excelブック添付ファイルOutlook電子メール送信処理
  Rem 作譜：Hitrock Camellia Shinopy
  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   第1版：2006/07/04：作成。
  Rem   第2版：2006/07/07：[電子メールの編集に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
    .VotingOptions "はい！;いいえ！"
    .Body = "添付ファイルを送付します。" & vbCrLf
    .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 *----*----*    *----*----*    *----*----*    *----*----*