Preset the "save as type" field while using Application.FileDialog(msoFileDialogSaveAs) with MSAccess

Late as usual but hopefully a better solution...

Public Function GetSaveFilename() As String

    Dim Dialog As FileDialog: Set Dialog = Application.FileDialog(msoFileDialogSaveAs)
    With Dialog
        .InitialFileName = CurrentProject.Path & "\*.ext"
        .FilterIndex = 2
        .Title = "Save As"
        If .Show <> 0 Then
            GetSaveFilename = .SelectedItems(1)
        End If
    End With
End Function

How it works?

As it is well know you can not directly set filters on msoFileDialogSaveAs. However if you set the InitialFileName to "*.ext" then it will force that extension. The filter will still say "All Files" however it will not show files unless they have the extension you provided.

The Result

If you erase "*.ext" and just write "test" for example the resulting filename will be "test.ext", so it actually forces that extension.

It's not perfect but it is very simple and achieves the desired result without resorting to API calls for those less experienced with code.

Caveats

This only works for a single extension at a time e.g. "*.csv". If you need to filter multiple extensions e.g. images then you will have to resort to using API calls.

As Mike wrote and from the link he proposed; to choose the filter you want by default, you can:

Sub Main()
    Debug.Print userFileSaveDialog("unicode", "*.txt")
End Sub

Function userFileSaveDialog(iFilter As String, iExtension As String)

    With Application.FileDialog(msoFileDialogSaveAs)
        Dim aFilterIndex As Long: aFilterIndex = 0&

        For aFilterIndex = 1& To .Filters.Count
            If (InStr(LCase(.Filters(aFilterIndex).Description), LCase(iFilter)) > 0) _
                And (LCase(.Filters(aFilterIndex).Extensions) = LCase(iExtension)) Then

                .FilterIndex = aFilterIndex
                Exit For

            End If
        Next aFilterIndex

        If CBool(.Show) Then
            userFileSaveDialog = .SelectedItems(.SelectedItems.Count)
        Else
            End
        End If
    End With

End Function

As stated he FileDialog help states msoFileDialogSaveAs is not supported.

You can force a CSV extension on FileName when the dialog unloads;

FileName = getCSVName(FileName)
...
Function getCSVName(fileName As String) As String
   Dim pos As Long
   pos = InStrRev(fileName, ".")
   If (pos > 0) Then
       fileName = Left$(fileName, pos - 1)
   End If
   getCSVName = fileName & ".CSV"
End Function

If excel isn't liking your CSV, check if there are any values you need to quote to escape newlines/" (http://stackoverflow.com/questions/566052/can-you-encode-cr-lf-in-into-csv-files)

And instead of this pattern;

For i = 0 To 40
   str = str & rs(i) & ", "    ' write each field seperated by a semi colon
Next i
str = Left(str, Len(str) - 2)   ' remove last semi colon and space

you can;

dim delimiter as string
...
For i = 0 To 40
   str = str & delimiter & rs(i)  ' write each field seperated by a semi colon
   delimiter = ","
Next