返信メールにファイル添付したい
「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