Public Function <\/span>GetSaveFile(Optional<\/span> strStartDir As String<\/span>, _\r\n Optional<\/span> strDefFileName As String<\/span>, _\r\n Optional<\/span> strFilter As String<\/span> = \"Alle Dateien (*.*)\", _\r\n Optional<\/span> strTitle As String<\/span>) As String<\/span>\r\n Dim <\/span>udtOpenFileName As <\/span>OPENFILENAME\r\n Dim <\/span>strExt As String<\/span>\r\n On Error GoTo<\/span> Fehler\r\n If <\/span>Len<\/span>(strStartDir) = 0 Then<\/span>\r\n strStartDir = CurrentProject.Path\r\n End If<\/span>\r\n With<\/span> udtOpenFileName\r\n .nStructSize = LenB(udtOpenFileName)\r\n .hwndOwner = Application.hWndAccessApp\r\n strFilter = strFilter & vbNullChar & vbNullChar\r\n .sFilter = strFilter\r\n .nFilterIndex = 1\r\n .sInitDir = strStartDir & vbNullChar\r\n .sDlgTitle = strTitle\r\n .sFile = Space$(256) & vbNullChar\r\n .nFileSize = Len<\/span>(.sFile)\r\n If <\/span>Len<\/span>(strDefFileName) <> 0 Then<\/span> \r\n Mid<\/span>(.sFile, 1) = strDefFileName\r\n End If<\/span>\r\n .sFileTitle = Space$(256) & vbNullChar\r\n .nTitleSize = Len<\/span>(.sFileTitle)\r\n If <\/span>GetSaveFileName(udtOpenFileName) Then<\/span>\r\n GetSaveFile = Left<\/span>(udtOpenFileName.sFile, InStr<\/span>(.sFile, vbNullChar) - 1)\r\n Else<\/span>\r\n GetSaveFile = \"\"\r\n End If<\/span>\r\n End With<\/span>\r\nEnde:\r\n Exit Function<\/span>\r\nFehler:\r\n MsgBox<\/span> Err.Description, vbCr<\/span>itical, \"GetSaveFileName\"\r\n Resume Ende\r\nEnd Function<\/span><\/pre>\nListing 1: Wrapperfunktion für die API-Funktion GetSaveFileName<\/span><\/b><\/p>\nDies sind die Parameter:<\/p>\n
\n- strStartDir<\/b>: Hier geben Sie das Verzeichnis an, das beim Öffnen des Dialogs vorausgewählt werden soll.<\/li>\n
- strDefFileName<\/b>: Vordefinierter Dateiname, der beim Öffnen des Dialogs im Feld Dateiname <\/b>eingetragen werden soll.<\/li>\n
- strFilter<\/b>: Ein Ausdruck, der angibt, welche Dateitypen als Speichername verwendet werden dürfen.<\/li>\n
- strTitle<\/b>: Titel des Dialogs<\/li>\n<\/ul>\n
Ablauf von GetSaveFile<\/h2>\n
Der Wrapperfunktion für die API-Funktion GetSaveFileName <\/b>haben wir einen etwas verkürzten Namen gegeben – eben GetSaveFile<\/b>. Sie definiert als Erstes eine Variable namens udtOpenFileName <\/b>des Typs OPENFILENAME<\/b>. Wie dieser genau aussieht und deklariert wird, zeigen wir weiter unten.<\/p>\n
Dieser Typ arbeitet wie eine Klasse und hat verschiedene Eigenschaften, die wir mit der Funktion GetSaveFile <\/b>füllen. nStructSize <\/b>nimmt beispielsweise die Größe des Typs udtOpenFileName<\/b> entgegen, die wir mit der Funktion LenB <\/b>ermitteln. Das ist übrigens auch eine der Änderungen der 64-Bit-Version gegenüber der 32-Bit-Version – früher wurde hier die Funktion Len <\/b>verwendet. Len <\/b>ermittelt die Anzahl der Zeichen einer Zeichenkette, LenB <\/b>die Anzahl der Bytes dieser Zeichenkette. hwndOwner <\/b>füllen wir mit dem Handle des aktuellen Fensters. Den Filter aus dem Parameter strFilter <\/b>erweitern wir noch um zwei vbNullChar<\/b>, bevor wir ihn der Eigenschaft sFilter <\/b>zuweisen. Gültige Werte dazu schauen wir uns gleich im Anschluss an. Welcher der Filter voreingestellt wird, legt die Funktion für die Eigenschaft nFilterIndex <\/b>fest, in diesem Fall mit dem Wert 1<\/b>.<\/p>\n
Das mit dem Parameter strStartDir <\/b>übergebene Startverzeichnis ergänzt die Funktion ebenfalls um vbNullChar <\/b>und schreibt sie dann in die Eigenschaft sInitDir<\/b>. Der Titel für den Dialog landet unbehandelt in sDlgTitle<\/b>.<\/p>\n
In sFile <\/b>trägt die Funktion eine leere Zeichenkette mit einer Länge von 256 Zeichen und einem abschließenden vbNullChar <\/b>ein. nFileSize <\/b>erhält die Länge von sFile<\/b>.<\/p>\n
<\/p>\n
Wenn der Aufruf einen Wert für den Parameter strDef-FileName <\/b>enthält, also den voreinzustellenden Speichernamen, wird dieser vorn in der Eigenschaft sFile <\/b>eingesetzt. Damit die Länge der darin enthaltenen Zeichenkette nicht verändert wird, verwenden wir dazu die Mid<\/b>-Funktion in einer eher unbekannten Art. Der Aufruf Mid(.sFile, 1) = strDefFileName <\/b>sorgt dafür, dass der Inhalt von strDefFileName <\/b>die entsprechenden Zeichen von .sFile <\/b>ab der ersten Position überschreibt.<\/p>\n
sFileTitle <\/b>soll den ermittelten Namen ohne Verzeichnis aufnehmen und wird mit 256 Leerzeichen plus abschließendem vbNullChar <\/b>gefüllt. Auch die Länge diese Zeichenkette landet in udtOpenFileName<\/b>, und zwar in der Eigenschaft nTitleSize<\/b>.<\/p>\n
Nachdem alle relevanten Eigenschaften von udtOpenFileName <\/b>gefüllt sind, ruft die Funktion die API-Funktion GetSaveFileName <\/b>mit udtOpenFileName <\/b>als Parameter auf. Liefert diese Funktion den Wert True <\/b>zurück, was der Fall ist, wenn der Benutzer die Schaltfläche OK <\/b>betätigt, schreibt die Funktion den Inhalt von sFile <\/b>aus udtOpenFileName <\/b>in den Rückgabewert der Funktion. Anderenfalls liefert die Funktion eine leere Zeichenkette zurück.<\/p>\nDeklaration der API-Funktion GetSaveFileName<\/h2>\n
Wichtig für die Einsatzbereitschaft der Funktion GetSaveFileName <\/b>unter 32-Bit- und 64-Bit-Office ist, dass Sie für beide Varianten die richtige Deklaration bereitstellen. Genau genommen ist es sogar so, dass Sie nur prüfen müssen, ob Sie VBA 6.x oder VBA 7.x verwenden. VBA 6.0 kam mit älteren Office-Versionen bis 2007. VBA 7 wurde eingeführt, um die Kompatibilität mit 64-Bit zu sichern. Grundsätzlich müssen wir also prüfen, welche Access-Version auf dem Zielrechner vorliegt und nicht, ob diese mit 32-Bit oder 64-Bit kompatibel ist (mehr dazu im Beitrag 32-Bit, 64-Bit, VBA-Version und Co. <\/b>(www.access-im-unternehmen.de\/1322<\/b>).<\/p>\n
Ausgangspunkt für diesen Beitrag war eine Version der Deklaration des Typen OPENFILENAME <\/b>und der Funktion GetSaveFileName<\/b>, die unter VBA 6.x erstellt wurde und dementsprechend mit dem Datentyp Long <\/b>auch für Zeiger und Handles arbeitet und die in der Deklaration der API-Funktion nicht das Schlüsselwort PtrSafe <\/b>verwendet.<\/p>\n
Diese funktioniert auch noch unter VBA 7.x, allerdings nur, wenn Office in der 32-Bit-Version vorliegt. Wir wollen nun eine Version der Deklaration erschaffen, die noch kompatibel mit VBA 6.x ist, aber auch mit VBA 7.x und somit auch mit 64-Bit. Dazu benötigen wir zwei Varianten, die wir in einer If…Then<\/b>-Bedingung unterscheiden. Weil wir in der Bedingung die Kompilierkonstante VBA7 <\/b>nutzen, müssen wir den Zeilen der Bedingung das Raute-Zeichen (#<\/b>) voranstellen. Damit werden die innerhalb der Bedingung aufgeführten Zeilen nur im Code berücksichtigt, wenn die jeweilige Bedingung wahr ist.<\/p>\n
In Listing 2 prüfen wir in der If…Then<\/b>-Bedingung den Wert der Kompilierkonstanten VBA7 <\/b>im If<\/b>-Teil der Bedingung. Dieser Teil enthält also den Code, der ausgeführt werden soll, wenn wir VBA 7.x nutzen. Der Else<\/b>-Teil führt den Code aus, der mit VBA 6.x kompatibel ist. Den Code aus dem Else<\/b>-Teil kennen Sie vermutlich aus älteren Beiträgen. Im If<\/b>-Teil für VBA 7.x haben wir kleine Änderungen vorgenommen:<\/p>\n#If VBA7 Then\r\nPrivate <\/span>Type OPENFILENAME\r\n nStructSize As Long<\/span>\r\n hwndOwner As Long<\/span>Ptr\r\n hInstance As Long<\/span>Ptr\r\n sFilter As String<\/span>\r\n sCustomFilter As String<\/span>\r\n nCustFilterSize As Long<\/span>\r\n nFilterIndex As Long<\/span>\r\n sFile As String<\/span>\r\n nFileSize As Long<\/span>\r\n sFileTitle As String<\/span>\r\n nTitleSize As Long<\/span>\r\n sInitDir As String<\/span>\r\n sDlgTitle As String<\/span>\r\n Flags As Long<\/span>\r\n nFileOffset As Integer<\/span>\r\n nFileExt As Integer<\/span>\r\n sDefFileExt As String<\/span>\r\n nCustData As Long<\/span>\r\n fnHook As Long<\/span>Ptr\r\n sTemplateName As String<\/span>\r\nEnd Type\r\nPrivate <\/span>Declare PtrSafe Function GetSaveFileName Lib \"comdlg32.dll\" Alias _\r\n \"GetSaveFileNameA\" (pOpenfilename As <\/span>OPENFILENAME) As Long<\/span>\r\n#Else\r\nPrivate <\/span>Type OPENFILENAME\r\n nStructSize As Long<\/span>\r\n hwndOwner As Long<\/span>\r\n hInstance As Long<\/span>\r\n sFilter As String<\/span>\r\n sCustomFilter As String<\/span>\r\n nCustFilterSize As Long<\/span>\r\n nFilterIndex As Long<\/span>\r\n sFile As String<\/span>\r\n nFileSize As Long<\/span>\r\n sFileTitle As String<\/span>\r\n nTitleSize As Long<\/span>\r\n sInitDir As String<\/span>\r\n sDlgTitle As String<\/span>\r\n Flags As Long<\/span>\r\n nFileOffset As Integer<\/span>\r\n nFileExt As Integer<\/span>\r\n sDefFileExt As String<\/span>\r\n nCustData As Long<\/span>\r\n fnHook As Long<\/span>\r\n sTemplateName As String<\/span>\r\nEnd Type\r\nPrivate <\/span>Declare Function GetSaveFileName Lib \"comdlg32.dll\" _\r\n Alias \"GetSaveFileNameA\" (pOpenfilename As <\/span>OPENFILENAME) As Long<\/span>\r\n#End If<\/pre>\nListing 2: Die Deklaration der API-Funktion GetSaveFileName plus dem Typ OPENFILENAME<\/span><\/b><\/p>\n\n- In der Deklaration des Typs OPENFILENAME <\/b>haben wir für die drei Eigenschaften hwndOwner<\/b>, hInstance <\/b>und fnHook <\/b>den Datentyp Long <\/b>durch LongPtr <\/b>ersetzt. Diese drei Eigenschaften enthalten Zeiger, Handle und Hook – nur diese müssen geändert werden, die übrigen Long<\/b>-Eigenschaften, die reine Zahlenwerte enthalten, bleiben erhalten.<\/li>\n
- In der Deklaration der API-Funktion GetSaveFileName <\/b>stellen wir dem Schlüsselwort Function <\/b>das Wort PtrSafe <\/b>voran.<\/li>\n
- Die letzte Änderung haben wir bereits besprochen – das Ändern der Funktion Len <\/b>zur Berechnung der Größe von OPENFILENAME <\/b>in LenB<\/b>.<\/li>\n<\/ul>\n
Wenn Sie sicher sind, dass Ihre Anwendung nur unter Access ab Version 2010 eingesetzt wird, können Sie natürlich auch nur den Teil im If<\/b>-Teil der Bedingung abbilden und die Bedingung weglassen. Das heißt, Sie müssen nur eventuell vorhandenen API-Code für VBA 6.x nach VBA 7.x migrieren.<\/p>\nDie Wrapper-Funktion GetSaveFile verwenden<\/h2>\n
Nun schauen wir uns noch einige Beispiele für den Aufruf von GetSaveFile <\/b>an, die Sie jeweils im Direktbereich absetzen können.<\/p>\n
Die einfachste Variante lautet:<\/p>\n
Debug.Print<\/span> GetSaveFile<\/pre>\nDamit erhalten wir den Dialog aus Bild 1. Der Titel ist mit dem vom System vorgegebenen Standardwert Speichern unter <\/b>belegt, der Filter lautet auf Alle Dateien (*.*) <\/b>und als Startverzeichnis nutzt der Dialog das beim Aufruf vorgegebene Verzeichnis der Datenbankdatei.<\/p>\n
![\"Standarddialog](\"..\/fileadmin\/_temp_\/2021_05\/pic_1321_001.png\")
<\/p>\n
Bild 1: Standarddialog zum Festlegen des Speichernamens einer Datei<\/span><\/b><\/p>\nStartverzeichnis festlegen<\/h2>\n
Dieses Startverzeichnis legen Sie mit dem ersten Parameter der Wrapper-Funktion GetSaveFile <\/b>fest, und zwar beispielsweise so:<\/p>\n GetSaveFile(\"c:\\Windows\")<\/pre>\nDamit starten wir direkt im Verzeichnis c:\\Windows<\/b>. Sie können hier beliebige Verzeichnisse angeben.<\/p>\n
Wenn das Verzeichnis nicht vorhanden ist, wird das Verzeichnis der aktuellen Datenbank angezeigt.<\/p>\n
Name der zu speichernden Datei vorgeben<\/h2>\n
Mit dem zweiten Parameter geben Sie an, ob der Name der zu speichernden Datei vorbelegt werden soll. Im folgenden Beispiel verwenden wir den Namen Beispiel.txt<\/b>:<\/p>\n GetSaveFile(CurrentProject.Path, \"Beispiel.txt\")<\/pre>\nDiesen Namen finden Sie dann wie in Bild 2 im Textfeld Dateiname <\/b>vor.<\/p>\n
![\"Vorgeben](\"..\/fileadmin\/_temp_\/2021_05\/pic_1321_002.png\")
<\/p>\n
Bild 2: Vorgeben des Dateinamens<\/span><\/b><\/p>\nFilter für den Dateityp setzen<\/h2>\n
Gegebenenfalls möchten Sie nur bestimmte Dateitypen zur Auswahl anbieten. Dann verwenden Sie den dritten Parameter von GetSaveFile<\/b>. Wenn nur Access-Datenbanken mit der Endung .accdb <\/b>angezeigt werden sollen, sieht das wie folgt aus:<\/p>\n GetSaveFile(CurrentProject.Path, , \"Access-Datenbanken (*.accdb)\" & Chr(0) & \"*.accdb\" & Chr(0))<\/pre>\nDer Filterausdruck setzt sich dabei aus verschiedenen Elementen zusammen. Der erste ist der Ausdruck, der in der Liste der Filter angezeigt werden soll. Danach folgt ein vbNullChar<\/b> (hier mit Chr(0) <\/b>kodiert), die Angabe des tatsächlichen Filters und ein abschließendes vbNullChar<\/b>.<\/p>\n
![\"Angabe](\"..\/fileadmin\/_temp_\/2021_05\/pic_1321_003.png\")
<\/p>\n