エクセルをVBAでOUTLOOKで送信したい（再）

質問

数年前にエクセルをPDFにして添付ファイルとしてOUTLOOKで送信するコードを教えてもらって毎日のように便利に使っているのですが、今回は元のマクロ付きエクセルのまま同じことがしたく、試行錯誤でpdfをxlmsに変えてみたら、メールは起動して来るのですが
「ファイルが見つかりません」とエクセルが添付されません。
どなたかどこを修正すれば良いのかHELPお願いします。

Option Explicit

Sub Saveaspdfandsend()
Dim xSht As Worksheet
'Dim xFileDlg As FileDialog
Dim xFolder As String
'Dim xYesorNo As Integer
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range

Const PdfDir = "\\XXXX\TEST報告書成績表" 'PDFを保存するフォルダー

Set xSht = ActiveSheet
'Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
'
'If xFileDlg.Show = True Then
'　 xFolder = xFileDlg.SelectedItems(1)
'Else
'　 MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"
'　 Exit Sub
'End If
xFolder = PdfDir & "\" & xSht.Cells(22, 5).Value & " " & xSht.Cells(1, 1).Value & ".pdf"

'Check if file already exist
'If Len(Dir(xFolder)) > 0 Then
'　　xYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", _
'　　　　　　　　　　　vbYesNo + vbQuestion, "File Exists")
'　　On Error Resume Next
'　　If xYesorNo = vbYes Then
'　　　　Kill xFolder
'　　Else
'　　　　MsgBox "if you don't overwrite the existing PDF, I can't continue." _
'　　　　　　　　　　& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
'　　　　Exit Sub
'　　End If
'　　If Err.Number <> 0 Then
'　　　　MsgBox "Unable to delete existing file.　Please make sure the file is not open or write protected." _
'　　　　　　　　　　& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
'　　　　Exit Sub
'　　End If
'End If

Set xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
'Save as PDF file
xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard

'Create Outlook email
Set xOutlookObj = CreateObject("Outlook.Application")
Set xEmailObj = xOutlookObj.CreateItem(0)
With xEmailObj
.Display
.To = "-----.co.jp"
.CC = "----.co.jp"
.Subject = "XXX報告書" & " " & Range("D10")
.Body = "お疲れ様です。" & vbLf & "表題の件、添付の通りです。 " & vbLf & " " & vbLf & "営業部"
.Attachments.Add xFolder
'If DisplayEmail = False Then
'.Send
'End If
End With
Else
MsgBox "The active worksheet cannot be blank"
Exit Sub
End If
End Sub

回答No.7

HohoPapa

久々に訪れてみたら、
見覚えのある「akira0723さん」の名前があるので、
参加させてもらいます。

akira0723さんのことですから、
質問内容にポストしたソースコードのほかにも記述があり
質問文だけでは洞察できないイベントを拾ったコードが記載されているものと推測します。

>今回は元のマクロ付きエクセルのまま同じことがしたく
やること自身はとてもシンプルに見えますが
自身に、
自身をメールで送信する機能を付加するのは
なかなかハードルが高く、私だったらやりません。
全体の動作やイベント、コードを知る尽くしたうえで実装する必要があります。
自身をPDF化して送信するのと同等レベルの話ではありません。

むしろ、
OUTLOOKで送信するだけのマクロブック（※１）を用意し
そのマクロブックを実行するとエクセルブック
（あるいは、PDFファイルなど任意ファイル）
を選択する画面を表示し
そこで選択したブックをoutlookが送信するようにすれば、
動作は安定するものと思います。
送信するマクロブックのフルパスが固定なら、
そのフルパスを※1のシートに予め書き込んでおくという仕様も考えられます。

そうすれば、
.To = "-----.co.jp"
.CC = "----.co.jp"
.Subject = "XXX報告書" & " " & Range("D10")
.Body = "お疲れ様です。" & vbLf & "表題の件、添付の通りです。 " & vbLf & " " & vbLf & "営業部"
といった送信先や件名、メール本文などを※１のシートに埋め込むことが可能となり
汎用性も広がるだろうと思います。

どのようなインターフェースにしたいかを説明してくれれば
コードを提示できると思います。