保存而不覆盖当前文件

Question

我正在使用以下代码生成我的电子表格的 PDF。

我需要添加一个功能来检查文件名是否已经存在于您尝试保存它的目录中，并允许更改名称。

我知道我需要创建另一个文件路径变量，但我完全不知道如何做其余的事情。

Sub PrintPDFAll()

    ThisWorkbook.Unprotect
    Worksheets("Entry").Unprotect     

    Dim MySheetName As String
    MySheetName = "Entry2"
    Sheets("Entry").Copy After:=Sheets("Entry")
    ActiveSheet.Name = MySheetName
    Range("ALL").FormatConditions.Delete
    Range("ALL").Interior.ColorIndex = 0

    'turn off screen updating
    Application.ScreenUpdating = False

    'open dialog and set file type
    Opendialog = Application.GetSaveAsFilename("", FileFilter:="PDF Files (*.pdf), *.pdf", _
                                        Title:="Quote")

    'if no value is added for file name
    If Opendialog = False Then
        MsgBox "The operation was not successful"

        Application.DisplayAlerts = False
        Sheets("Entry2").Delete
        Worksheets("Entry").Activate
        Exit Sub
    End If

    'create the pdf
    On Error Resume Next

    Sheets("Summary").Move Before:=Sheets(1)
    Sheets("Breakdown").Move Before:=Sheets(2)
    Sheets("Entry2").Move Before:=Sheets(3)
    Sheets(Array("Entry2", "Breakdown", "Summary")).Select

    With ActiveSheet.PageSetup
        .Orientation = xlPortrait
        .Zoom = False
        .FitToPagesWide = 1
        .CenterHorizontally = True
        .CenterVertically = True
        .BottomMargin = 0
        .TopMargin = 0
        .RightMargin = 0
        .LeftMargin = 0
    End With

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Opendialog, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

    'error handler
    On Error GoTo 0

    'clear the page breaks
    ActiveSheet.DisplayPageBreaks = False

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Sheets("Entry2").Delete
    Sheets("Entry").Move Before:=Sheets(1)
    Sheets("Breakdown").Move Before:=Sheets(2)
    Sheets("Summary").Move Before:=Sheets(3)

    Worksheets("Entry").Activate
    Worksheets("Entry").Protect
    ThisWorkbook.Protect

End Sub

Answer 1

我刚刚发现自己需要解决与此处相同的问题，现在有了更多的经验，我已经能够自己解决了。我想我也可以 post 我是怎么做到的，以防万一有人需要它。

我在网上找到了以下功能，用于搜索目录：

Function IsFile(ByVal fName As String) As Boolean
'Returns TRUE if the provided name points to an existing file.
'Returns FALSE if not existing, or if it's a folder
    On Error Resume Next
    IsFile = ((GetAttr(fName) And vbDirectory) <> vbDirectory)
End Function

然后在我的代码中修改了以下内容，这样如果发现重复的文件，它会循环直到你输入一个非重复的文件名：

...
TryAgain:
    ...
    Opendialog = Application.GetSaveAsFilename("", filefilter:="PDF Files (*.pdf), *.pdf", _
                                        Title:="Your Doc")
    'if no value is added for file name
    If Opendialog = False Then
        MsgBox "The operation was not successful"
        Exit Sub

    End If
    If IsFile(Opendialog) = True Then
        MsgBox "File Already Exists"
    Opendialog = ""
    End If

If Opendialog = "" Then
    GoTo TryAgain
End If

保存而不覆盖当前文件

Save without overwriting current files

excel

vba

pdf-generation

save

savefiledialog