Datei zum Speichern auswählen

Möchte man aus einem Makro heraus eine Datei speichern und dem Benutzer dabei die Möglichkeit bieten, das Laufwerk, das Verzeichnis und den Dateinamen selber festzulegen, steht eigentlich nur eine Funktion zur Verfügung: Das Word-interne Dialogfeld Dialogs(wdDialogsFileSaveAs) (siehe  wd-Konstanten der Dialogfelder).

Dieses Dialogsfeld besitzt aber den Nachteil, dass nur vordefinierte Formattypen ausgewählt werden können. Möchte man z.B. ein Dialogfenster ähnlich dem der VBAIDE zum Export eines Moduls oder einer Userform verwenden, stösst man schnell auf das Problem, dass die entsprechenden Formattypen nicht angeboten werden.
Um diese Einschränkung zu umgehen, kann auf das API GetSaveFileName aus der CommonDialog32-Bibliothek zurückgegriffen werden, sofern diese Datei comdlg32.dll auf dem Rechner vorhanden und registriert ist.
Dieses API stellt dabei ein "Datei speichern"-Dialogsfenster zur Verfügung, das über Parameter flexibel angepasst werden kann: z.B. mit eigenen Formattypen.

Public Declare Function GetSaveFileName Lib "comdlg32.dll" _
  Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long 

Dieser auf den ersten Blick sehr einfache API-Aufruf verbirgt seine Möglichkeiten hinter der Parameter-Struktur  OPENFILENAME: Diese Struktur beinhaltet nicht nur Initialisierungsinformationen für das Dialogfenster, sondern liefert auch Informationen über den angegebenen Dateinamen, Dateipfad und Verzeichnis zurück.
Allerdings liefert dieser API-Aufruf keine Informationen zurück, wenn der Benutzer den Dialog abbricht oder wenn ein Fehler auftritt. Um diese Fehler abzufangen, kann das API CommDlgExtendedError verwendet werden.

Public Type OPENFILENAME
    lStructSize As Long 
    hwndOwner As Long 
    hInstance As Long 
    lpstrFilter As String 
    lpstrCustomFilter As String 
    nMaxCustFilter As Long 
    nFilterIndex As Long 
    lpstrFile As String 
    nMaxFile As Long 
    lpstrFileTitle As String 
    nMaxFileTitle As Long 
    lpstrInitialDir As String 
    lpstrTitle As String 
    flags As Long 
    nFileOffset As Integer 
    nFileExtension As Integer 
    lpstrDefExt As String 
    lCustData As Long 
    lpfnHook As Long 
    lpTemplateName As String 
End Type  

Das folgende Beispiel öffnet ein Dialogfenster zum Exportieren von VBA-Prozeduren (Userforms,Module oder Klassenmodule) mit dem angegebenen Titel. Über die festgelegten Filter werden nur diese Dateiendungen angeboten.

Function fkt_FileSaveAs(sModul, sType) As String  
Dim sFilters As String 
Dim intError As Integer 
' Formattyp-Filter festlegen  
sFilters = "Formulardateien(*.frm)" & vbNullChar & "*.frm" & vbNullChar & _
           "Basic-Dateien (*.bas)" & vbNullChar & "*.bas" & vbNullChar & _
           "Klassendateien (*.cls)" & vbNullChar & "*.cls" & vbNullChar & _
           "Alle Dateien" & vbNullChar & "*.*" & vbNullChar & vbNullChar
With OFName
  'Setzt die Größe der OPENFILENAME Struktur  
  .lStructSize = Len(OFName)
  'Der Window Handle ist bei VBA fast immer &O0  
  .hwndOwner = &O0
  ' Formattyp-Filter setzen  
  .lpstrFilter = sFilters
  ' Auswerten des Dateityps zur Auswahl des Filers  
  Select Case sType
  Case ".frm"
  .nFilterIndex = 1
  Case ".bas"
  .nFilterIndex = 2
  Case ".cls"
  .nFilterIndex = 3
  Case Else 
  .nFilterIndex = 4
  End Select 
  ' Buffer für Dateinamen erzeugen  
  .lpstrFile = sModul & Space$(1024) & vbNullChar & vbNullChar
  ' Maximale Anzahl der Dateinamen-Zeichen  
  .nMaxFile = Len(.lpstrFile)
  ' Buffer für Titel erzeugen  
  .lpstrFileTitle = Space$(254)
  ' Maximale Anzahl der Titel-Zeichen  
  .nMaxFileTitle = 255
  ' Anfangsverzeichnis vorgeben  
  .lpstrInitialDir = "c:\temp"
  .lpstrDefExt = sType & vbNullChar & vbNullChar
  ' Titel des Dialogfester festlegen  
  .lpstrTitle = "Modul exportieren"
  ' Flags zum Festlegen eines bestimmten Verhaltens,  
  ' OFN_LONGNAMES = lange Dateinamen verwenden  
  ' OFN_OVERWRITEPROMPT = Abfrage vorm Überschreiben  
  .flags = OFN_LONGNAMES Or OFN_OVERWRITEPROMPT
End With 
' API aufrufen und evtl. Fehler abfangen  
intError = GetSaveFileName(OFName)
If intError <> 0 Then 
  fkt_FileSaveAs = Left(OFName.lpstrFile, InStr(1, OFName.lpstrFile, Chr(0)) -1)
ElseIf intError = 0 Then 
  ' Abbruch durch Benutzer oder Fehler
End If 
End Function