检查有效的用户输入文件路径

Question

我正在为工作编写一个宏，最后，试图保存。它将可供群组访问，因此保存文件的位置不会是静态的。

我要求用户指定文件的保存位置，如果文件路径无效，则抛出错误。

它说我的文件路径无效。

Dim CurrDate As String
Dim SaveLoc As String
Dim SaveBook As String

CurrDate = Format(Date, "MMDDYY")

SaveLoc = InputBox("Please specify the folder with file path where you would like to save your file:")
SaveBook = SaveLoc + "\" + "MyFile - " & CurrDate

If Dir(SaveBook) <> "" Then
    ActiveWorkbook.Save
    ActiveWorkbook.SaveAs Filename:=SaveBook
Else
    MsgBox "File path does not exist. Please enter a valid file path:"
End If

Answer 1

有一个比InputBox更好的替代品。

Application.FileDialog(msoFileDialogFolderPicker)

链接到 Microsoft Learn of Excel.Application.FileDialog

With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "xxx"
    If .Show = -1 Then ' if OK is pressed
        sFolder = .SelectedItems(1)
        'create file in folder
    End If
End With

Answer 2

将 Excel 文件保存到另一个位置

• 输入路径是一种拖动。而是使用

  File Dialog

  对象让用户选择文件夹。

  PickFolder

  辅助函数打开对话框并返回所选文件夹的路径，如果取消对话框则返回空字符串。
• 虽然保存为

  .xlsx

  文件时不需要指定文件扩展名，但无论如何都要指定文件扩展名。
• 如果工作簿从未保存过，则无法使用

  Save

  来保存它。
• 以下内容还涵盖了一些其他潜伏的惊喜。

主要

Sub SaveExcelFile()
    Const PROC_TITLE As String = "Save Excel File"
    On Error GoTo ClearError

    Const DIALOG_TITLE As String = "Pick the Save Location"
    Const FILE_NAME_PREFIX As String = "MyFile - "
    Const FILE_EXTENSION As String = ".xlsx"
    Const FILE_FORMAT As Long = xlOpenXMLWorkbook
    Const DATE_FORMAT As String = "MMDDYY"
    
    Dim wb As Workbook: Set wb = ActiveWorkbook
    ' If the workbook is supposed to be the workbook containing this code,
    ' use 'ThisWorkbook' instead of 'ActiveWorkbook'.
    
    Dim FolderPath As String: FolderPath = PickFolder(, DIALOG_TITLE)
    
    If Len(FolderPath) = 0 Then
        MsgBox "Folder dialog canceled!", vbExclamation, PROC_TITLE
        GoTo ProcExit
    End If
        
    Dim FilePath As String: FilePath = FolderPath & FILE_NAME_PREFIX _
        & Format(Date, DATE_FORMAT) & FILE_EXTENSION
    
    Dim OverwriteAnswer As Long
    
    If Len(Dir(FilePath)) > 0 Then ' file exists
        OverwriteAnswer = MsgBox("The file """ & FilePath _
            & """ already exists!" & vbLf & vbLf _
            & "Do you want to overwrite it?", _
            vbQuestion + vbYesNo + vbDefaultButton2, PROC_TITLE)
        If OverwriteAnswer = vbNo Then
            MsgBox "File save canceled!", vbExclamation, PROC_TITLE
            GoTo ProcExit
        End If
    End If
        
    If Len(wb.Path) = 0 Then ' workbook was never saved
        ' cannot use 'Save'; can still use 'SaveAs'
    Else ' workbook was previously saved
        If Not wb.Saved Then wb.Save ' save only if not saved (efficiency)
    End If
    
    Dim ErrNumber As Long
    
    Application.DisplayAlerts = False ' prevent file exists & file format alerts
        On Error Resume Next ' prevent error if invalid file path
            wb.SaveAs Filename:=FilePath, FileFormat:=FILE_FORMAT
            ErrNumber = Err.Number
        On Error GoTo ClearError
    Application.DisplayAlerts = True
    
    If ErrNumber <> 0 Then
        MsgBox "Could not save the file as """ & FilePath & """!", _
            vbExclamation, PROC_TITLE
        Exit Sub
    End If
    
    MsgBox "File saved as """ & FilePath & """.", vbInformation, PROC_TITLE
    
ProcExit:
    Exit Sub
ClearError:
    MsgBox "Run-time error '" & Err.Number & "':" & vbLf & vbLf _
        & Err.Description, vbCritical, PROC_TITLE
    Resume ProcExit
End Sub

帮助

Function PickFolder( _
    Optional InitialFolderPath As String = "", _
    Optional DialogTitle As String = "Browse", _
    Optional DialogButtonName As String = "OK", _
    Optional ShowCancelMessage As Boolean = False) _
As String
    With Application.FileDialog(4) ' 4 = msoFileDialogFolderPicker
        .Title = DialogTitle
        .ButtonName = DialogButtonName
        Dim pSep As String: pSep = Application.PathSeparator
        Dim FolderPath As String
        ' Note that the following 'If' statement is NOT redundant.
        If Len(InitialFolderPath) > 0 Then
            If Right(InitialFolderPath, 1) = pSep Then
                FolderPath = InitialFolderPath
            Else
                FolderPath = InitialFolderPath & pSep
            End If
            .InitialFileName = FolderPath
        End If
        If .Show Then
            FolderPath = .SelectedItems(1)
            If Right(FolderPath, 1) <> pSep Then FolderPath = FolderPath & pSep
            PickFolder = FolderPath
        Else
            If ShowCancelMessage Then
                MsgBox "Folder dialog canceled!", vbExclamation, "Pick Folder"
            End If
        End If
    End With
End Function