OutlookVBA（メール＞クリップボード）TEST

Outlook VBAでメールオブジェクトでクリップボード取得

VBA設定

①Outlookを起動

②Alt + F11でMicrosoft Visual Basic for Applications

③「フォーム」追加
　「プロジェクト」ウィンドウのプロジェクトツリーを選択し、
　「右クリック」＞「ファイルのインポート(I)...」をクリック、
　ダイアログが表示されるので対象のファイル[XXXX.frm]を選択して
　「開く(O)」をクリックする。

④「モジュール」追加
　「プロジェクト」ウィンドウのプロジェクトツリーを選択し、
　「右クリック」＞「ファイルのインポート(I)...」をクリック、
　ダイアログが表示されるので対象のファイル[XXXX.frm]を選択して
　「開く(O)」をクリックする。

⑤Outlookに戻り、適当なメールをクリックして
メッセージウィンドウを表示し、
　左上の「クィックアクセスツールバーのユーザー設定」を選択して
　メニューが表示されるので「その他のコマンド(M)...」をクリック
Outlookのオプションが開くので「コマンドの選択(C)」から
　「マクロ」を選択し、追加するマクロを選択＞「追加(A)>>」をクリックする。

メールオブジェクト取得

 Public Sub GetMail()
    On Error Resume Next
    Dim objItem As Object
    Dim objIns As Inspector

    Set objIns = Application.ActiveInspector
    Set objItem = objIns.CurrentItem   '今開いているメールオブジェクトを取得

    GetMailForm.txt_ReciveTime = objItem.SentOn
    GetMailForm.txt_from = objItem.SenderName
    GetMailForm.txt_subject = objItem.Subject
    GetMailForm.txt_Body = """" & objItem.Body & """"
    GetMailForm.Show
    
 End Sub

メールオブジェクトからクリップボードへ転送、下の関数を経由

Public Sub PutClipBoad()

    Dim buf As String
    
    buf = GetMailForm.txt_ReciveTime.Value & "," & GetMailForm.txt_from.Value & "," & GetMailForm.txt_subject.Value & "," & GetMailForm.txt_Body.Value
    
    SetCB (buf)
    
End Sub

一旦フォームを経由してクリップボードへ転送

Sub SetCB(ByVal str As String)

    'クリップボードに文字列を格納
    With CreateObject("Forms.TextBox.1")
        .MultiLine = True
        .Text = str
        .SelStart = 0
        .SelLength = .TextLength
        .Copy
    End With

End Sub

フォームのボタンイベント設定

Private Sub btnCancel_Click()
    
    Unload Me

End Sub

Private Sub btnOK_Click()

    PutClipBoad
    Unload Me
    
End Sub