0

「Outlook 受領メールを全員に返信(送信前)」を改変してファイルが添付できるようにしたいです。

以下のように追加してみたのですがエラーになります。

どのように修正したらよいか教えてください。

'--------------------------------------------------------------------
'メイン
'--------------------------------------------------------------------

'Mail Format
Const olFormatHTML = 2
Const olFormatPlain = 1
Const olFormatRichText = 3
Const olFormatUnspecified = 0

Dim oApp
Dim oSelection
Dim oMail
Dim oReplyMail
Dim oInspector

Dim sTitle
Dim sSendMsg
Dim attachmentFile1
Dim fname

On Error Resume Next
Set oApp = GetObject(, "Outlook.Application")

If oApp Is Nothing Then

On Error GoTo 0
Err.Raise 1, "", "Outlookが起動されていません。"
WScript.Quit()
End If

On Error GoTo 0
Set oSelection = oApp.ActiveExplorer.Selection

If oSelection.Count > 1 Or oSelection.Count = 0 Then
Err.Raise 1, "", "選択されたメールが1つではありません。"
WScript.Quit()
End If

sTitle = !件名!
sSendMsg = !メール内容!
attachmentFile1 = !添付ファイル1!

If sSendMsg = "" Then
Err.Raise 1, "", "メール内容を入力してください。"
WScript.Quit()
End If

Set oMail = oSelection.Item(1)
Set oReplyMail = oMail.ReplyAll()

If sTitle <> "" Then
oReplyMail.Subject = sTitle
End If

oReplyMail.Display()

Set oWordEditor = oReplyMail.GetInspector.WordEditor
oWordEditor.Windows(1).Selection.Text = sSendMsg
oWordEditor.Windows(1).Selection.End = 0

If attachmentFile1 <> "" Then
    fname = attachmentFile1
    SetUMSVariable "$FILE_PATH_TYPE", "11"
    SetUMSVariable "$PARSE_FILE_PATH", fname
    attachmentFile = GetUMSVariable("$PARSE_FILE_PATH")
    If attachmentFile1 = "" Then
        attachmentFile1 = fname
    End If
End If

'添付ファイルを添付 olByValue=1
Set myAttachments = mITEM.Attachments
If attachmentFile1 <> "" Then
    myAttachments.Add attachmentFile1, 1, 1
End If

茄子天 編集済みのコメント
回答とコメントは、会員登録(無料)で閲覧できるようになります。