Arbeitsmappe mittels VBA umbenennen und speichern
Peter Seitz
ich habe ein Excel Arbeitsblatt (Excel 97, SR2), welches durch ein Makro
gelöscht wird und fuer die Neueingabe vorbereitet wird.
Dabei ist es zwingend erforderlich, dass die Arbeitsmappe unter einem
neuen Namen abgespeichert wird, da sonst die "alten" Daten verloren gehen
koennen.
Ich habe nun versucht mit folgendem Code ein Abspeichern unter neuem Namen
zu erzwingen:
' Nun Arbeitsmappe umbenennen um alte Daten zu sichern und unter
' neuem Namen (ohne Pfadvorgebe) abspeichern.
Dateispeichern:
On Error GoTo Fehler
Do While ZuSpeicherndeDatei = False
'Nachfolgender Dialog läßt sich nicht abbrechen!!!
ZuSpeicherndeDatei = Application.GetSaveAsFilename(InitialFilename:=myDateiName, _
FileFilter:="Excel Arbeitsmappen (*.xls)(*.xls),*.xls,Alle Dateien (*.*)(*.*),*.*", _
FilterIndex:=1, Title:="Speichern im privaten Homeverzeichnis (Bestätigung mit [Speichern] erforderlich)")
Loop
' Falls Abbruch gedrückt würde, würde Datei nicht gespeichert...
If ZuSpeicherndeDatei <> False Then
ActiveWorkbook.SaveAs FileName:=ZuSpeicherndeDatei, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End If
Exit Sub
Fehler:
Select Case Err
Case 1004:
MsgBox "Zugriff auf die Datei " & ActiveWorkbook.Name & _
" verweigert. Stellen Sie sicher, daß diese Datei" _
& " nicht von einer anderen Applikation geöffnet ist" _
& " oder speichern Sie die Datei unter anderem Namen", _
vbOKOnly + vbExclamation, "Programmfehler aufgetreten"
' MsgBox "Fehler # " & Err & " : " & Error(Err)
GoTo Dateispeichern
Case Else:
MsgBox "Fehler # " & Err & " : " & Error(Err)
End Select
Wenn ich nun bereits eine Datei mit dem neu vorgeschlagenen Namen habe, kommt
eine Warnmeldung, welche mich fragt, ob ich die Datei überschreiben möchte.
Wenn ich hier auf NEIN klicke, dann wird die Datei nicht umbenannt und gespeichert.
Diesen Fall moechte ich also abfangen.
In obigen Code springe ich dann nochmal auf Dateispeichern.
Nun kommt aber die Fehlermeldung :
Laufzeitfehler '1004':
Die Methode 'SaveAs' fuer as Objekt '_Workbook' ist fehlgeschlagen.
Muss ich hier gegebenenfalls die Fehlerroutine nochmals zuruecksetzen, oder
ist mein obiger Code nicht ganz gluecklich?
Danke fuer Euere Hilfe.
--
Peter Seitz
Deutschsprachige Windows NT Diskussionsliste
<mailto:majo...@fbzslinux.tu-graz.ac.at?body=subscribe%20winnt-de>
Michael Schüller
"Peter Seitz" <se...@gewi.kfunigraz.ac.at> schrieb im Newsbeitrag
news:en2#i#1JCHA.972@tkmsftngp12...
> Ich habe nun versucht mit folgendem Code ein Abspeichern unter neuem Namen
> zu erzwingen:
>
> ' Nun Arbeitsmappe umbenennen um alte Daten zu sichern und unter
> ' neuem Namen (ohne Pfadvorgebe) abspeichern.
> Dateispeichern:
>
> On Error GoTo Fehler
> Do While ZuSpeicherndeDatei = False
> 'Nachfolgender Dialog läßt sich nicht abbrechen!!!
> ZuSpeicherndeDatei =
Application.GetSaveAsFilename(InitialFilename:=myDateiName, _
> FileFilter:="Excel Arbeitsmappen (*.xls)(*.xls),*.xls,Alle Dateien
(*.*)(*.*),*.*", _
> FilterIndex:=1, Title:="Speichern im privaten Homeverzeichnis
(Bestätigung mit [Speichern] erforderlich)")
> Loop
> ' Falls Abbruch gedrückt würde, würde Datei nicht gespeichert...
> If ZuSpeicherndeDatei <> False Then
> ActiveWorkbook.SaveAs FileName:=ZuSpeicherndeDatei, _
> FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
> ReadOnlyRecommended:=False, CreateBackup:=False
> End If
[...]
> Wenn ich nun bereits eine Datei mit dem neu vorgeschlagenen Namen habe,
kommt
> eine Warnmeldung, welche mich fragt, ob ich die Datei überschreiben
möchte.
> Wenn ich hier auf NEIN klicke, dann wird die Datei nicht umbenannt und
gespeichert.
> Diesen Fall moechte ich also abfangen.
Füge _vor_ die "ActiveWorkbook.SaveAs"-Zeile ein:
Application.DisplayAlerts = False
Dadurch werden Meldungen wie 'Datei besteht bereits' erst gar nicht
angezeigt.
Nach SaveAs setzt du übrigens besser wieder
Application.DisplayAlerts = True
Hoffe ich konnte Dir helfen.
--
Schönen Gruß
Michael
michael....@gmx.de
Peter Seitz
: Hallo Peter,
: [...]
Ich habe mich scheinbar zu ungenau ausgedrueckt. Das ist nicht das von
mir gewünschte:
Ich moechte die Datei zwar speichern, aber eine gegebenenfalls vorhandene
Datei nicht überschreiben. Sollte also die Warnmeldung kommen, dann
moechte ich diese zwar mit nein beantworten koennen (=nicht überschreiben),
aber ich moechte dann aufgefordert werden einen neuen Namen festzulegen.
[...]
Michael Schüller
"Peter Seitz" <se...@gewi.kfunigraz.ac.at> schrieb im Newsbeitrag
news:OGqHog#JCHA.2436@tkmsftngp12...
>
> : Füge _vor_ die "ActiveWorkbook.SaveAs"-Zeile ein:
> : Application.DisplayAlerts = False
>
> : Dadurch werden Meldungen wie 'Datei besteht bereits' erst gar nicht
> : angezeigt.
> Ich habe mich scheinbar zu ungenau ausgedrueckt. Das ist nicht das von
> mir gewünschte:
>
> Ich moechte die Datei zwar speichern, aber eine gegebenenfalls vorhandene
> Datei nicht überschreiben. Sollte also die Warnmeldung kommen, dann
> moechte ich diese zwar mit nein beantworten koennen (=nicht
überschreiben),
> aber ich moechte dann aufgefordert werden einen neuen Namen festzulegen.
Erstmal ein Klugscheißer-Hinweis: Lies bitte mal http://got.to/quote (ich
zitiere sicher auch nicht perfekt, aber der Hinweis musste sein)
Zur Lösung Deines Problems (ich hoffe, ich habe Dich diesmal verstanden):
Dim ZuSpeicherndeDatei As String
Dim vFileExists As Boolean
Do
ZuSpeicherndeDatei = Application.GetSaveAsFilename
If ZuSpeicherndeDatei <> "Falsch" Then 'wurde Speicherpfad ausgewählt?
vFileExists = (Dir(ZuSpeicherndeDatei) <> "") 'Prüfen ob Datei
besteht
If vFileExists Then
MsgBox ("Datei besteht")
End If
Else
MsgBox ("Abgebrochen")
End If
Loop Until Not vFileExists Or ZuSpeicherndeDatei = "Falsch" 'erneut fragen,
bis "gültige" Eingabe oder Abbruch
If Not vFileExists And ZuSpeicherndeDatei <> "Falsch" Then 'speichern, falls
gültige Eingabe und kein Abbruch
ActiveWorkbook.SaveAs Filename:=ZuSpeicherndeDatei
End If