使用带有MSAccess的Application.FileDialog(msoFileDialogSaveAs)时,预设"保存类型"字段

Question

我搜遍了各种方法来做到这一点.

我想打开另存为对话框,以便用户可以选择保存文件的位置.但是,我希望"保存类型"字段预设为"逗号分隔值文件(*.csv)"

问题是"过滤器"方法似乎不适用于"msoFileDialogSaveAs".是否可以使用"Application.FileDialog(msoFileDialogSaveAs)"预设文件类型？

目前,如果我使用.csv扩展名保存文件,然后在excel中打开它,我会收到" 您尝试打开的文件xxx.csv的格式与文件扩展名指定的格式不同... "信息.该文件可正常工作.

 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
                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

比你!

Answer 1

像往常一样晚,但希望更好的解决方案......

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

这个怎么运作？

众所周知,您不能直接在msoFileDialogSaveAs上设置过滤器.但是,如果将InitialFileName设置为"*.ext",则会强制执行该扩展.过滤器仍然会显示"所有文件",但它不会显示文件,除非它们具有您提供的扩展名.

结果

如果你删除"*.ext"并只写"test",例如生成的文件名将是"test.ext",所以它实际上会强制扩展.

它并不完美,但它非常简单,并且无需对代码经验较少的人使用API​​调用即可获得所需的结果.

注意事项

这仅适用于一次扩展,例如"*.csv".如果您需要过滤多个扩展名,例如图像,那么您将不得不求助于使用API​​调用.

Answer 2

正如Mike所写，他从链接中提出了建议。要选择默认所需的过滤器，您可以：

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

Answer 3

如前所述，他FileDialog帮助状态msoFileDialogSaveAs不受支持。

FileName您可以在对话框卸载时强制启用 CSV 扩展；

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

如果 Excel 不喜欢您的 CSV，请检查是否需要引用任何值来转义换行符/” (http://stackoverflow.com/questions/566052/can-you-encode-cr-lf-in-into -csv 文件）

而不是这种模式；

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

你可以;

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