エクセルでセル内容でpdfで保存しメールの起動まで
長くなってしまって済みません。
先日（2018/12/28）ここで上記のマクロのコードを教えてもらって問題なく使い始めたのですが、別のBookにコピーして、ファイル名のセルを（10,4）と(1,1)から（15,4)と（1,1)）に変更すると「実行時エラー 13、型が一致しません」と出ます。
うまくいっているシートのファイル名はD10＋A1のセルで、今度はD15＋A1をファイル名にしただけなのですが。。。。
(10,4)と(1,1)のままだと普通にメールが起動してくるのですがD10が空白セルの為A1の内容だけでファイル名になってしまいます。
ちなみにそのシートのD10に数値＋アルファベットを入れると「型が一致しません」と上記と同じエラーが出ます。
教えてもらったコードのファイル名の（下の）セルの数値だけ変えたらうまくいったと思うのですが、今回はなぜかエラーになってしまいます。
質問ではA1＋B1で質問しましたので(1,1)と(1,2)になっています。
xFolder = PdfDir + "\" + xSht.Cells(1, 1).Value & xSht.Cells(1, 2).Value + ".pdf"
全部のコードは下記の通りです。
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 = "C:\OKWave" '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(1, 1).Value & xSht.Cells(1, 2).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 = ""
.CC = ""
.Subject = ""
.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
お礼
ご回答ありがとうございました。 ＞"SaveAs"を使わないで"SaveCopyAs"を使ってみては。 アドバイスにしたがって試してみました。 なんと、既存のファイルを残したまま、別のファイルを保存することができました。 ソースコードの"SaveAs"を、"SaveCopyAs"に変えただけです。 助かりました。本当にどうもありがとうございます！