如何从excel导出pdf文件时，文件名已经存在，然后有一个消息框是/否与VBA

Question

如何从excel导出pdf文件时，文件名已经存在，然后有一个消息框是/否与VBA ?

请推荐，这样我就可以在消息框中选择是否替换它和另一个"定制"。这是一个子文件夹，我希望有一个消息框，如果没有找到子文件夹。

感谢

Sub PrintToPDF()
Dim strFilename     As String
Dim rngRange        As Range
Dim cust     As Range
Dim strcust As String
Set cust = Worksheets("Sheet1").Range("B2")
Set rngRange = Worksheets("Sheet1").Range("C4")
strcust = cust.Value
strFilename = rngRange.Value
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"D:test inv" & cust & "" & strFilename & ".pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
End Sub

Answer 1

ActiveSheet To PDF (Dir)

Sub ActiveSheetToPDF()

' Define constants.
Const PROC_TITLE As String = "ActiveSheet To PDF"
Const INITIAL_FOLDER_PATH As String = "D:test inv"

' Reference the active sheet.
Dim sh As Object: Set sh = ActiveSheet
If sh Is Nothing Then
MsgBox "No visible workbooks open.", vbExclamation, PROC_TITLE
Exit Sub
End If

' Build the initial folder path.

Dim pSep As String: pSep = Application.PathSeparator
Dim iPath As String: iPath = INITIAL_FOLDER_PATH
If Right(iPath, 1) <> pSep Then iPath = iPath & pSep

Dim TestName As String: TestName = Dir(iPath, vbDirectory)

If Len(TestName) = 0 Then
MsgBox "The initial path '" & iPath & "' doesn't exist.", _
vbCritical, PROC_TITLE
Exit Sub
End If

' Retrieve the folder and the file name.

Dim BaseName As String, FolderName As String

With sh.Parent.Worksheets("Sheet1")
FolderName = CStr(.Range("B2").Value)
If Len(FolderName) = 0 Then
MsgBox "The cell with the folder name is blank.", _
vbCritical, PROC_TITLE
Exit Sub
End If
BaseName = CStr(.Range("C4").Value)
If Len(BaseName) = 0 Then
MsgBox "The cell with the file base name is blank.", _
vbCritical, PROC_TITLE
Exit Sub
End If
End With

' Build the folder path.

Dim FolderPath As String: FolderPath = iPath & FolderName & pSep
TestName = Dir(FolderPath, vbDirectory)

Dim MsgAnswer As VbMsgBoxResult

If Len(TestName) = 0 Then
MsgAnswer = MsgBox("The folder '" & FolderName _
& "' doesn't exist in '" & iPath & "'." & vbLf & vbLf _
& "Do you want it created?", vbQuestion + vbYesNo, PROC_TITLE)
If MsgAnswer = vbNo Then Exit Sub
Dim ErrNum As Long
On Error Resume Next
MkDir FolderPath
ErrNum = Err.Number
On Error GoTo 0
If ErrNum <> 0 Then
MsgBox "The path '" & FolderPath & "' couldn't be created.", _
vbCritical, PROC_TITLE
Exit Sub
End If
End If

' Build the file path.

Dim FilePath As String: FilePath = FolderPath & BaseName & ".pdf"
TestName = Dir(FilePath)

If Len(TestName) > 0 Then
MsgAnswer = MsgBox("A file named '" & TestName _
& "' already exists in '" & FolderPath & "'." & vbLf & vbLf _
& "Do you want to overwrite it?", vbQuestion + vbYesNo, PROC_TITLE)
If MsgAnswer = vbNo Then Exit Sub
End If

' Export.
sh.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FilePath, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True

' Inform.
MsgBox "Sheet '" & sh.Name & "' printed to PDF.", _
vbInformation, PROC_TITLE

End Sub