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

vybvopom  于 2022-12-20  发布在  其他
关注(0)|答案(2)|浏览(173)

如何从excel导出pdf文件,当文件名已经存在,然后有一个消息框是/否与VBA?
请建议,以便与消息框,我可以选择是否是或不是取代它和另一个“cust”这是一个子文件夹,我希望有一个消息框太,如果没有找到子文件夹。
谢啦,谢啦

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
wko9yo5t

wko9yo5t1#

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

djmepvbi2#

要检查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

相关问题