EXCEL VBA、手動Outlook電子メール送信者、クラスモジュール問題

Question

このトピックに関する私の1st questionに記載されている問題に取り組んでいます。短いリフレッシュのために、それは各リストユニットに電子メールのテンプレートと添付ファイルのリストを含むExcelファイルです。与えられたユニットのテンプレートを開くボタンを追加していくつかの変更を加え、ファイルを添付してメールを表示しますユーザー。ユーザーは必要に応じてメールを修正し、メールを送信するかどうかを指定できます。私は以下に述べるいくつかのアプローチを試みました。 残念ながら、クラスモジュールに関する問題は今や遅れています。まもなくhereと書かれています。私はこのような「EmailWatcher」として、クラスモジュールを作成しても、法の小さな組み合わせはhereを説明します持っている：

Option Explicit 
Public WithEvents TheMail As Outlook.MailItem 

Private Sub Class_Terminate() 
Debug.Print "Terminate " & Now() 
End Sub 

Public Sub INIT(x As Outlook.MailItem) 
    Set TheMail = x 
End Sub 

Private Sub x_Send(Cancel As Boolean) 
Debug.Print "Send " & Now() 
ThisWorkbook.Worksheets(1).Range("J5") = Now() 
'enter code here 
End Sub 

Private Sub Class_Initialize() 
Debug.Print "Initialize " & Now()  
End Sub 

次の形式への変更がすべての変更を行いません。

Option Explicit 
Public WithEvents TheMail As Outlook.MailItem 

    Private Sub Class_Terminate() 
    Debug.Print "Terminate " & Now() 
    End Sub 

    Public Sub INIT(x As Outlook.MailItem) 
     Set TheMail = x 
    End Sub 

    Private Sub TheMail_Send(Cancel As Boolean) 
    Debug.Print "Send " & Now() 
    ThisWorkbook.Worksheets(1).Range("J5") = Now() 
    'enter code here 
    End Sub 

    Private Sub Class_Initialize() 
    Debug.Print "Initialize " & Now()  
    End Sub 

モジュールのコードは以下の通りです：

Public Sub SendTo() 
    Dim r, c As Integer 
    Dim b As Object 
    Set b = ActiveSheet.Buttons(Application.Caller) 
    With b.TopLeftCell 
     r = .Row 
     c = .Column 
    End With 

    Dim filename As String, subject1 As String, path1, path2, wb As String 
    Dim wbk As Workbook 
    filename = ThisWorkbook.Worksheets(1).Cells(r, c + 5) 
    path1 = Application.ThisWorkbook.Path & 
    ThisWorkbook.Worksheets(1).Range("F4") 
    path2 = Application.ThisWorkbook.Path & 
    ThisWorkbook.Worksheets(1).Range("F6") 
    wb = ThisWorkbook.Worksheets(1).Cells(r, c + 8) 

    Dim outapp As Outlook.Application 
    Dim oMail As Outlook.MailItem 
    Set outapp = New Outlook.Application 
    Set oMail = outapp.CreateItemFromTemplate(path1 & filename) 

    subject1 = oMail.subject 
    subject1 = Left(subject1, Len(subject1) - 10) & 
    Format(ThisWorkbook.Worksheets(1).Range("D7"), "DD/MM/YYYY") 
    oMail.Display 
    Dim CurrWatcher As EmailWatcher 
    Set CurrWatcher = New EmailWatcher 
    CurrWatcher.INIT oMail 
    Set CurrWatcher.TheMail = oMail 

    Set wbk = Workbooks.Open(filename:=path2 & wb) 

    wbk.Worksheets(1).Range("I4") = 
    ThisWorkbook.Worksheets(1).Range("D7").Value 
    wbk.Close True 
    ThisWorkbook.Worksheets(1).Cells(r, c + 4) = subject1 
    With oMail 
     .subject = subject1 
     .Attachments.Add (path2 & wb) 
    End With 
    With ThisWorkbook.Worksheets(1).Cells(r, c - 2) 
     .Value = Now 
     .Font.Color = vbWhite 
    End With 
    With ThisWorkbook.Worksheets(1).Cells(r, c - 1) 
     .Value = "Was opened" 
     .Select 
    End With  
End Sub 

は、最後に私が働いているクラスを作っていると私はあなたがクラスMODUから見ることができるようにそれを確認するためにいくつかのコントロールを配置していますルコード。しかし問題は、Sendイベントを捕捉しないということです。クラスはサブの終わりで終了しています。電子メールをユーザーに完全に送ってください。問題は、間違いはどこですか？または、クラスモジュールをいわゆる「待機モード」、あるいはその他の提案のままにする方法は？ 私は「送信トレイ」のメールを検索する方法についても検討しますが、送信イベントのアプローチははるかに有利です。

Answer 1

私は同様の質問hereに答えて、それを見て、あなたは正しい道を歩いている間に、実装にいくつかの問題があると思います。

クラスモジュールをそのまま使用して、不要なINIT手順を取り除き、手順Class_Initializeを使用してMailitemを作成してください。

Option Explicit 
Public WithEvents TheMail As Outlook.MailItem 
    Private Sub Class_Terminate() 
    Debug.Print "Terminate " & Now() 
    End Sub 
    Private Sub TheMail_Send(Cancel As Boolean) 
    Debug.Print "Send " & Now() 
    ThisWorkbook.Worksheets(1).Range("J5") = Now() 
    'enter code here 
    End Sub 
    Private Sub Class_Initialize() 
    Debug.Print "Initialize " & Now() 
    'Have Outlook create a new mailitem and get a handle on this class events 
    Set TheMail = olApp.CreateItem(0) 
    End Sub 

通常のモジュールで使用するための例は、&はこれが働いていると（私の以前の答えは達成していなかった）複数の電子メールを処理する確認テスト。

Option Explicit 
Public olApp As Outlook.Application 
Public WatchEmails As New Collection 

Sub SendEmail() 
If olApp Is Nothing Then Set olApp = CreateObject("Outlook.Application") 
Dim thisMail As New EmailWatcher 
WatchEmails.Add thisMail 
thisMail.TheMail.Display 
thisMail.TheMail.To = "someone@email.com" 
thisMail.TheMail.Subject = "test" 
thisMail.TheMail.Display 
End Sub 

どのように動作しますか？最初に、Outlook.Applicationインスタンスを使用することを確認します。これはPublicとしてスコープされるので、他の手順&クラスで利用できるようになります。

次に、EmailWatcherクラスの新しいインスタンスを作成し、Class_Initializeイベントを発生させます。このイベントを利用し、すでに処理されたOutlook.Applicationのインスタンスを作成して&を作成し、TheMailオブジェクトイベントハンドラを割り当てます。

SendMailプロシージャの実行時間が終了した後でもスコープ内に残るように、これをPublicコレクションに格納します。このようにして、複数の電子メールを作成し、すべてのイベントを監視することができます。その時点から

、thisMail.TheMailは、そのイベントのExcelの下で監視されて、このオブジェクトに.Sendメソッドを呼び出す（VBAを介して）、または手動で電子メールを送信するTheMail_Sendイベントプロシージャを上げるべきMailItemを表します。

Answer 2

Dim CurrWatcher As EmailWatcher

この行は任意のサブルーチンの外に、グローバルにする必要があります。

Answer 3

ご協力ありがとうございました。

私はメールのテンプレートを使用するので、コレクションに追加する方法を理解するのに時間がかかります。

私の解決策です。 クラスモジュール：

Option Explicit 
Public WithEvents themail As Outlook.MailItem 

Private Sub Class_Terminate() 
Debug.Print "Terminate " & Now() 
End Sub 

Private Sub themail_Send(Cancel As Boolean) 
Debug.Print "Send " & Now() 
Call overwrite(r, c) 
'enter code here 
End Sub 

Private Sub Class_Initialize() 
Debug.Print "Initialize " & Now() 
'Have Outlook create a new mailitem and get a handle on this class events 
Set themail = OutApp.CreateItem(0) 
Set themail = oMail 
End Sub 

モジュール：提案のための

Public Sub SendTo1() 

Dim r, c As Integer 
Dim b As Object 
Set b = ActiveSheet.Buttons(Application.Caller) 
With b.TopLeftCell 
    r = .Row 
    c = .Column 
End With 

Dim filename As String, subject1 As String, path1, path2, wb As String 
Dim wbk As Workbook 
filename = ThisWorkbook.Worksheets(1).Cells(r, c + 5) 
path1 = Application.ThisWorkbook.Path & 
ThisWorkbook.Worksheets(1).Range("F4") 
path2 = Application.ThisWorkbook.Path & 
ThisWorkbook.Worksheets(1).Range("F6") 
wb = ThisWorkbook.Worksheets(1).Cells(r, c + 8) 

Dim OutApp As Outlook.Application 
Dim oMail As Outlook.MailItem 
Set OutApp = New Outlook.Application 
Set oMail = OutApp.CreateItemFromTemplate(path1 & filename) 

oMail.Display 
subject1 = oMail.subject 
subject1 = Left(subject1, Len(subject1) - 10) & 
Format(ThisWorkbook.Worksheets(1).Range("D7"), "DD/MM/YYYY") 

Dim currwatcher As EmailWatcher 
Set currwatcher = New EmailWatcher 
currwatcher.INIT oMail 
Set currwatcher.themail = oMail 

Set wbk = Workbooks.Open(filename:=path2 & wb) 

wbk.Worksheets(1).Range("I4") = ThisWorkbook.Worksheets(1).Range("D7").Value 
wbk.Close True 
ThisWorkbook.Worksheets(1).Cells(r, c + 4) = subject1 
With oMail 
    .subject = subject1 
    .Attachments.Add (path2 & wb) 
End With 
With ThisWorkbook.Worksheets(1).Cells(r, c - 2) 
    .Value = Now 
    .Font.Color = vbWhite 
End With 
With ThisWorkbook.Worksheets(1).Cells(r, c - 1) 
    .Value = "Was opened" 
    .Select 
End With 
Application.DisplayAlerts = True 
Application.ScreenUpdating = True 

End Sub