Sub 返信用メール作成_Click()
Dim objOutlook As New Outlook.Application
Dim objMail As Outlook.MailItem
Set objMail = objOutlook.ActiveExplorer.Selection.Item(1)
Dim objReply As Outlook.MailItem
Set objReply = objMail.ReplyAll
Dim objForward As Outlook.MailItem
Set objForward = objMail.Forward
Dim MeilSet As Worksheet
Set MeilSet = ThisWorkbook.Sheets(“返信用メール作成”)
Dim NS As Outlook.Namespace
Set NS = objOutlook.GetNamespace(“MAPI”)
Dim objFolder As Outlook.Folder
Dim FSO As Object
Set FSO = CreateObject(“Scripting.FileSystemObject”)
Dim WSH As Object
Set WSH = CreateObject(“Wscript.Shell”)
Dim 本文
本文 = “担当者” & vbCrLf & MeilSet.Range(“$A1”).Value & “ 様” _
& vbCrLf & vbCrLf _
& “いつもお世話になっております。” & vbCrLf & “株式会社○○の” & MeilSet.Range(“$A2”).Value & “です。” _
& vbCrLf & vbCrLf _
& MeilSet.Range(“$A3”).Value & “ について、” & vbCrLf _
& “依頼されていた作業が正常に完了いたしました。” _
& vbCrLf & vbCrLf _
& “以上、よろしくお願いいたします。”
※vbCrLf →改行
※Excelに特定の文字を入力し、本文中に挿入します。
Dim 全文
全文 = 本文 & vbLf & vbLf & 署名(“署名.txt”) ‘本文 + Function 署名を挿入’
With objForward
objForward.To = objReply.To ‘メール宛先
objForward.CC = objReply.CC ‘メールCC
objForward.Subject = objReply.Subject ‘メール件名
objForward.Body = 全文 & .Body ‘メール本文
objForward.BodyFormat = olFormatPlain ‘メール形式に設定
End With
MeilSet.Range(“$A1”).MergeArea.ClearContents ‘担当者名クリア
MeilSet.Range(“$A2”).MergeArea.ClearContents ‘作業者名クリア
MeilSet.Range(“$A3”).MergeArea.ClearContents ‘依頼名クリア
objForward.Display ‘画面を表示する
objForward.Save ‘下書き保存
Set objOutlook = Nothing
Set objMail = Nothing
Set objForward = Nothing
Set NS = Nothing
Set objFolder = Nothing
End Sub
入会申込
ログイン
