Function SaveFile(Optional stInitPath As String = "C:", _
                  Optional stButtonName As String = "", _
                  Optional stCaption As String = "", _
                  Optional stMask As String = "All files; *.*") As String
  
  Const TYPE_SPLTR As String = ";"
  Const ITEM_SPLTR As String = ","
  
  Dim strFileName As String
  Dim dlgSave As FileDialog
  Dim v, s As Variant
  Dim lnItemCounter, lnTypeCounter As Long
  
  On Error GoTo SaveFile_Err
    Set dlgSave = Application.FileDialog(msoFileDialogSaveAs)
    With dlgSave
      .InitialFileName = stInitPath
      If stCaption <> "" Then
        .Title = stCaption
      End If
      If stButtonName <> "" Then
        .ButtonName = stButtonName
      End If
      lnItemCounter =  0 
      ' Вот тут это кусок начинается
      .Filters.Clear
      For Each v In Split(stMask, ITEM_SPLTR)
        lnItemCounter = lnItemCounter +  1 
        lnTypeCounter =  0 
        For Each s In Split(v, TYPE_SPLTR)
           lnTypeCounter = lnTypeCounter +  1 
           If lnTypeCounter <  2  Then
            .Filters.Add Trim(s), Trim(Mid(v, Len(s) +  3 , Len(v) - Len(s) -  1 ))
           End If
        Next s
      Next v
      ' А вот тут заканчивается
      .InitialView = msoFileDialogViewDetails
      .Show
      SaveFile = .SelectedItems( 1 )
    End With
    
SaveFile_Exit:
  Exit Function
  
SaveFile_Err:
  SaveFile = ""
  Resume SaveFile_Exit
End Function