Access から　Outlookを操作する

質問

_{2019年7月15日月曜日 13:58}

初めまして。

操作されるOutlookにはあらかじめメール送信時に以下のようなVbYesnoのMsgboxが出現するようになっています。

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim rc As Integer
'.
'.
'省略
'
'.
    rc = MsgBox("処理を行いますか？", vbYesNo ; vbQuestion, "確認")
    If rc = vbYes Then
        MsgBox "処理を行います"
    Else
        Cancel = True
        Exit Sub ''
    End If
End Sub

操作する側(Access)では次のようなコードでメール送信を制御しています。

Sub Test()
  'Outlookオブジェクトの変数宣言
  Dim outlookObj As Outlook.Application
  Set outlookObj = New Outlook.Application
  
  'メール送信用のオブジェクト作成
  Dim mailObj As Outlook.MailItem
  Set mailObj = outlookObj.CreateItem(olMailItem)
 
  'メール送信内容の作成
  With mailObj
    .To = "xxxxxxxxxxxxx@xxxxx.xxx" 'メール宛先"
    .Subject = "新しいメールの件名"    'メール件名
    .Body = "メール本文をここに書くよ。" 'メール本文
    .BodyFormat = olFormatPlain     'メール形式に設定
  End With
  
  'メール送信
  mailObj.Send
End Sub

Outlookが起動していないときはそのまま送れますが、起動しているとMsgboxが出現します。

msgboxにYesとAccessから操作してOutlookの送信を実行させたいのですが、どのようなコードが必要になるのでしょうか。

どなたか、外部操作を経験された方、またはご存知の方がみえれば、ご教授ください。

よろしくお願いします。

すべての返信 (8)

_{2019年7月16日火曜日 1:17 ✅回答済み | 1 票}

OutlookはEnableEventsがないので難しいですね。

「Outlookが起動していないときはそのまま送れる」のなら、Outlookが起動している場合は一旦閉じて処理した後、再び閉じることはせずに Visible = True にしておけば良いのでは？

もちろん、Outlookが起動しているということはユーザーが何らかの処理をしている可能性があるので、閉じてよいかどうか、確認メッセージを出すなどの対応は必要かと思いますが・・

Dim outlookObj As Object

On Error Resume Next
Set outlookObj = GetObject(, "Outlook.Application")
On Error GoTo 0

If Not outlookObj Is Nothing Then
    If MsgBox("Outlookを再起動します。続けてよろしいですか？", vbOKCancel Or vbQuestion) = vbCancel Then Exit Sub
    outlookObj.Quit
    Set outlookObj = Nothing
End If

---

_{2019年7月15日月曜日 14:28 | 1 票}

Outlook側のマクロに手を入れることができるなら、メッセージボックスを表示させないというフラグを作ってしまうとか

'oulook側
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

    Dim fromAccess As Boolean
    fromAccess = False
    If TypeOf Item Is MailItem Then
    
        Dim user As UserProperty
        Dim mi As MailItem
        Set mi = Item
        
        Set userp = mi.UserProperties.Find("FromAccess")
        If Not userp Is Nothing Then
            'ユーザーフィールドが見つかった
            If userp.Type = olYesNo Then
                Dim yesno As Boolean
                yesno = user.Value
                If (yesno = True) Then
                    'アクセスから？
                    fromAccess = True
                End If
            End If
            
            userp.Delete '不要なので消しておく
        End If
    End If
    
    If fromAccess = False Then
        'アクセスからでなければダイアログ表示
        
        Dim rc As VbMsgBoxResult
        rc = MsgBox("処理を行いますか？", vbYesNo ; vbQuestion, "確認")
        If rc = vbYes Then
            MsgBox "処理を行います"
        Else
            Cancel = True
            Exit Sub ''
        End If
    End If
   
End Sub

Option Explicit

'Access側
Sub Test()
  'Outlookオブジェクトの変数宣言
  Dim outlookObj As Outlook.Application
  Set outlookObj = New Outlook.Application
  
  'メール送信用のオブジェクト作成
  Dim mailObj As Outlook.MailItem
  Set mailObj = outlookObj.CreateItem(olMailItem)
 
 Dim userp As Outlook.UserProperty
 
  'メール送信内容の作成
  With mailObj
    .To = "xxxxxxxxxxxxx@xxxxx.xxx" 'メール宛先"
    .Subject = "新しいメールの件名"    'メール件名
    .Body = "メール本文をここに書くよ。" 'メール本文
    .BodyFormat = olFormatPlain     'メール形式に設定
    
    'ユーザーフィールドにAccessから実行したというフラグを設定しておく
    Set userp = .UserProperties.Add("FromAccess", olYesNo, False)
    userp.Value = True
  End With
  
  'メール送信
  mailObj.Send
End Sub

個別に明示されていない限りgekkaがフォーラムに投稿したコードにはフォーラム使用条件に基づき「MICROSOFT LIMITED PUBLIC LICENSE」が適用されます。(かなり自由に使ってOK!)

---

_{2019年7月15日月曜日 23:38}

ご回答ありがとうございます。Outlook側ではコードに手を加えられない状況なのですが、

gekkaさん案は理解できました。

Access側で処理できるような案をもう少し考えてみたいです。

---

_{2019年7月16日火曜日 1:23 | 1 票}

こんにちは。

Outlookが起動していない時に上手くいくのでしたら、一度Outlookを終了させてはいかがでしょうか。

Option Explicit

Public Sub Sample()
  Dim outlookObj As Object
  Dim flg As Boolean
  Const OutlookProcessName = "OUTLOOK.EXE"
  Const olMailItem = 0
  Const olFormatPlain = 1
  
  'Outlookが起動していたら一度終了させる
  On Error Resume Next
  Set outlookObj = GetObject(, "Outlook.Application")
  On Error GoTo 0
  If Not outlookObj Is Nothing Then
    outlookObj.Quit
    flg = True
    'プロセス終了待ち
    Do
      DoEvents
    Loop While ProcessExists(OutlookProcessName) = True
  End If
  
  Set outlookObj = CreateObject("Outlook.Application")
  With outlookObj.CreateItem(olMailItem)
    .Subject = "新しいメールの件名"
    .To = "xxxxxxxxxxxxx@xxxxx.xxx"
    .Body = "メール本文をここに書くよ。"
    .BodyFormat = olFormatPlain
    .Send
  End With
  
  '終了したOutlookを再度起動
  If flg = True Then Shell OutlookProcessName, vbNormalFocus
End Sub

Private Function ProcessExists(ByVal ProcessName As String) As Boolean
  Dim items As Object
  Dim ret As Boolean
  
  Set items = CreateObject("WbemScripting.SWbemLocator") _
            .ConnectServer.ExecQuery("Select * From Win32_Process Where Name = '" & ProcessName & "'")
  If items.Count > 0 Then ret = True
  ProcessExists = ret
End Function

また、下記サイトに記載されているような問題があり、一般的にはマルチポストはマナー違反として敬遠される行為ですので、投稿する際は気を付けた方が良いかと思います。

・掲示板でマルチポストはなぜいけないの？
http://www.ml-info.com/weekly/archives/2009/091024o.html

---

_{2019年7月16日火曜日 1:34}

もしくは、下記のコードで。

  'メール送信
  AppActivate outlookObj
  SendKeys "y"
  mailObj.Send

---

_{2019年7月16日火曜日 5:32}

ありがとうございます。

.sendで待機状態になっているわけですから、操作しようないですね、

Accesst側で一旦、別のアプリ立ち上げてそこからの操作になるのか

それともシンプルにアウトルックを事前に一旦閉じるしかないかな。

とりあえず、息詰まりそうなので解決とさせていただきます。

---

_{2019年7月16日火曜日 5:32}

ありがとうございます。

.sendで待機状態になっているわけですから、操作しようないですね、

とりあえず、息詰まりそうなので解決とさせていただきます。

---

_{2019年7月16日火曜日 7:19}

解決後になんですが、待機状態になったときにSendkeysが送られるはずです。

下記構文でご希望通りメッセージは閉じませんか？

  AppActivate outlookObj
  SendKeys "y"
  mailObj.Send