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

I searched all over for a way to do this.

I want to open a Save As dialog box so the user can choose the location to save a file. But, I want the "Save as type" field to be preset with "comma seperated value File (*.csv)"

The problem is the "Filter" methode does not seem to work with "msoFileDialogSaveAs". Is it possible to preset the file type using "Application.FileDialog(msoFileDialogSaveAs)"?

At the moment, if I save the file with the .csv extension and then open it in excel, I get the "The file you are trying to open xxx.csv is in a different format than specified by the file extension ..." message. The file works correctly though.

 With Application.FileDialog(msoFileDialogSaveAs)
        .Title = "xxx"
        .AllowMultiSelect = False
        .InitialFileName = "xxx.csv"
        '.Filter = "txt files (*.txt)|*.txt|All files (*.*)|*.*"
        result = .Show
        If (result <> 0) Then
            ' create file
            FileName = Trim(.SelectedItems.Item(1))
            fnum = FreeFile
            Open FileName For Output As fnum


            ' Write the csv data from form record set
            For Each fld In rs.Fields
               str = str & fld.Name & ", "
            Next

           ' Write header line
           str = Left(str, Len(str) - 2)   ' remove last semi colon and space
           Print #fnum, str
           str = ""

          ' Write each row of data
           rs.MoveFirst
          Do While Not rs.EOF             
            For i = 0 To 40开发者_如何学C
                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
            Print #fnum, str
            str = ""
            rs.MoveNext
           Loop

        ' close file
        Close #fnum
        End If
  End With

Than You!

---

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 

---

http://msdn.microsoft.com/en-us/library/office/aa219834(v=office.11).aspx

Use filterindex to select the desired extension from the default list (launch the dialog and count down the list to your extension), or modify the saveas filter collection as documented in the page linked at msdn. The filters can't be changed within the filedialog instance, only prior to that with a filedialogfilters object via Application.FileDialog(msoFileDialogSaveAs).Filters. They are then available within the instance.

---

Dim FileDialogObj As FileDialog

'1.0 Open File Dialog
Set FileDialogObj = Application.FileDialog(msoFileDialogSaveAs)
With FileDialogObj
   .InitialFileName = "C:\"
   .Filters.Item 3  '****This is to set File Dialog Save As to CSV ******
   .Title = "Save As"
   .AllowMultiSelect = False
End With