活动工作表转换为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

要检查1个文件是否存在：

Public Function checkFileExist(mPath As String) As Boolean
    Dim FSO As Object
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    checkFileExist = FSO.fileExists(mPath)
    Set FSO = Nothing
End Function

检查1个文件夹是否存在：

Public Function checkFolderExist(mPath As String) As Boolean
    Dim FSO As Object
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    checkFolderExist = FSO.folderExists(mPath)
    Set FSO = Nothing
End Function

要显示消息确认：

Dim a as Integer
a=MsgBox("Do you want save?", vbOKCancel)
If a = vbOK Then
  'Save file....
   
End If