AW: Datei speichen - Name vorgeben
17.08.2006 09:30:59
ingUR
Hallo, Marco,
schon in meinem ersten Antwortbeitrag auf Deine Eröffnunsfrage, deutete ich an, indem ich den "Platzhalter "Speicherroutine..." im Programmcode benutzte, dass mehrere Vorgehensweisen zur Verwaltung von Verzeichnissen und Dateien in VBA-Codes gibt.
Der Weg über den Standarddialog-Nummer xlDialogSaveAs der Application-Dialogliste führt bei der Vorbelegung zu den festgestellten Schwierigkeiten, da der Dialog nicht das in Übergabeparameter enthaltene Verzeichnis mit der Show-Methode öffnet.
Daran ändert auch nichts der Einsatz der VB-Befehle ChDrive "E" (wechselt z.B. zum Laufwerk E) und ChDir "C:\temp\verz2" (wechselt zum angegeben Verzeichnis) die man vor der Eröffnung einsetzt, obwohl dieses Vorgehensweise in der Literatur und im Internet beschreiben wird.
Also gilt es eine andere Möglichkeit zu nutzen und da bietet sich, will man nicht mit einem FileSystemObject arbeiten, die Workbook-eigene Speicherfunktion SaveAs einzuseten. Diese alledings eröffne kein Dialog, so dass dieser zuvor über die Applications-Methode GetSaveAs ausgeführt werdden muß. Im Gegensatz zum Standarddialog xlDialogSaveAs, der das Speichern bei Bestätigung sofort erledigt, liefert die GetSaveAs-Methode nur die gewählten Parameter an den aufrufer zurück ohne dass der Speichervorgang ausgeführt wird.
Die Enscheidung, was mit diesem Rückabewert geschieht, erfolgt dan in der weiteren Programmroutine, wo das Ereignis Abbruch mit dem Rückgabestring "Falsch" beantwortet wird, womit die Prozedur sprachabhängig wird.
Vor dem Einsatz der GetSaveAs-Methode sind jedoch die Verzeichnisse einzustellen.
Soll die Verzeichnisswahl nicht im Dialog erfolgen, dann ist nun festzustellen, ob der gewählte Pfad existiert.
If Dir(strPathName, vbDirectory) = "" Then
Der VB-Dir-Befehl liefert bei gültigem Pfadname (1.Parameter) diesen wieder zurück, wenn er als Pfad (2. Parameterwert:= vbDirectory) geöffent werden kann. Wird ein Leer-String zurückgefoefert ist, nach positiven Enscheid der Vergehensabfrage beim Benutzer, der Pfad mit dem VB-Befehl MkDir(strPathName) anzulegen, andernfalls ist die Routine zu beenden.
Wird die Sub-Proczdur fortgesetzt, werden nun in den nächsten beiden Programmzeilen der aktuelle Pfadname und der daraus ermittelbare aktuelle Laufwerksbuchstabe zwischengespeichert, um nach Abschluß des Speicherblocks die vorgefundene Einstellung wieder herzustellen.
Anschliessend wird auf das gewählte Laufwerk und dort in den gewählten Pfad gewechselt.
Da die folgende Woorkbook-Methode GetSaveAs, wie oben bereits erwähnt nur einen Rückgabe wert liefert, ohne eigentlich zu Speichen, muß das in die Stringvariabel strReturnPathFName zurückgelieferte Ereignis ausgewertet werden.
Die nachfolgende Fehelrbehandlungsoption dient dazu, dass bei Abbruch des Speichervorganges (z.B. Meldung: "Datei existiert bereits, soll sie überschrieben werden?" Antwort "nein" oder "Abbruch", daraus folgt Fehlernummer, die in mit der Eigenschaftsabfrage Err.Number ermittelt wird) bei der nächsten Programmzeile, die die Fehlernummer auswertet, fortgefahren wird.
Abschließen werden die bei Eintrit in die Speicherroutine vorgefundenen Laufwer- und Pfadeinstellungen wiederhergestellt.
Das ganze als Programmcode:
Option Explicit
Private Sub CommandButton1_Click()
Dim strFName As String, strRootPath As String, strPathName As String
strRootPath = "C:\TEMP\" ' TEMP ggf. durch gleichbleibenden Vorspann des Path
' ersetzen, unter denen sich die Unterverzeichnisse
' Verz1 und Verz2 befinden.
strFName = Worksheets("Tabelle1").Range("A1")
Select Case Left(UCase(strFName), 1)
Case "A": strPathName = "Verz1"
Case "B": strPathName = "Verz2"
Case "C": strPathName = "Verz3"
Case "D": strPathName = "Verz4"
Case "E": strPathName = "Verz5"
Case Else
MsgBox "Unzulässiger Kennbuchstabe, Datei wird nicht gesichert"
Exit Sub
End Select
strPathName = strRootPath + strPathName + "\"
Dim OldDir As String, OldDrive As String
Dim strReturnPathFName As String, strMsg As String, antw As VbMsgBoxStyle
If Dir(strPathName, vbDirectory) = "" Then
strMsg = "Verzeichnis " & vbLf & _
strPathName & vbLf & _
"nicht vorhanden" & vbLf & _
"Soll es angelegt werden?"
antw = MsgBox(strMsg, vbYesNo + vbDefaultButton1, "Verzeichnisverwaltung")
If antw Then
MkDir (strPathName)
Else
Exit Sub
End If
End If
OldDir = CurDir
OldDrive = Left(OldDir, 1)
ChDrive (strPathName)
ChDir strPathName
strReturnPathFName = Application.GetSaveAsFilename(strFName, "Excel-File (*.xls), *.xls", , "MySave")
If Not (strReturnPathFName = "Falsch") Then
On Error Resume Next
ActiveWorkbook.SaveAs (strReturnPathFName)
If Err.Number <> 0 Then
strMsg = "Speichern von" & vbLf & _
strPathName & strFName & vbLf & _
"ist fehlgeschlagen oder wurde abgebrochen!"
MsgBox strMsg
End If
End If
ChDrive (OldDrive)
ChDir (OldDir)
End Sub
Die Auswahl der Verzeichnisse im vorgesteltem Programmcode, die ja nach dem Anfangsbuchstaben des Dateinamens über die Selectschleife erfolgt, kann in dem vorgestellten Fall auch einfacher gestalltet werden, da sich der Unterverzeichnisname Verz+Ordnungszahl auch berechnen läßt, da der Buchstabe A durch den Zahlcode 65 dargestellt wird:
VNr = Asc(Left(UCase(strFName), 1))-64 'Bei A=1, B=2,C=3....
strPathName=""
if VNr > 0 and VNr < 27 then strPathName="Verz" & VNr
if len(strPathName)=0 then ... Hinweis-/Ausstiegsroutine wie unter "Case Else"
Möglicherweise ergibt sich bei Dir eine ähnliche Formelmäßigkeit der Verzeichnisnamenbildung, die dann an Stelle des "Select Case"-Blocks treten könnte.
Gruß,
Uwe