use vba to save to a non existing text file using a "save-as" style dialog box

use vba to save to a non existing text file using a "save-as" style dialog box

I have a macro that outputs to a text file.

What I want is a "save" type dialog box that allows me get the path of an as yet non existent file, by bringing up a file explorer dialogue box.

What I have managed so far is a prompt that requires you to type the file name with full path (not ideal), or to save to an existing file using an "open" style dialog box.

Example code below.

Sub UseOpenDialog()
    Dim DestFile As String

    ' Open the file dialog
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Text File", "*.txt"
        .Filters.Add "All Files", "*.*"

        If .Show = True Then
            DestFile = .SelectedItems(1)
            dosomething (DestFile)
        Else: MsgBox "nothing selected"
        End If

    End With
End Sub

Sub TypeFullPath()
    Dim DestFile As String

    DestFile = InputBox("Enter the destination filename" _
     & Chr(10) & "(with complete path):", "Title")
    dosomething (DestFile)
End Sub

Sub dosomething(x)

    MsgBox x

End Sub

答案1

Found this after some searching

Excel has "Application.GetSaveAsFilename" which returns the a string of the full path of a file using a save as style box, or FALSE if the prompt is exited.

Implementation for saving to a text file, with appropriate prompts.

Sub saveas()
    Dim Destfile As Variant
saveas::     'bring up saveas dialogue with filters
        Destfile = Application.GetSaveAsFilename(title:="Export", _
            fileFilter:= _
            "Text Files (*.txt; *.csv), *.txt;*.csv," & _
            "All Files (*.*),*.*")

        'exit sub with message if no file selected
        If Destfile = False Then
            MsgBox "no file selected"
            Exit Sub

        'prompt user for overwrite confirmation
        ElseIf Dir(Destfile) <> "" Then
            If MsgBox("Overwrite " & Dir(Destfile) & "?", vbYesNo) = vbNo Then GoTo saveas
        'beware of velociraptors
        End If

    dosomething (Destfile)

End Sub

相关内容