Office: Vorhandene Datei durch neue Datei ersetzen

terryjak · 16. September 2008

Hi,

Ich möchte von einer Datei ("Ursprungsdatei.xls") eine Kopie in einem bestimmten Ordner speichern. Der Name dieser neuen Datei beinhaltet den Wert einer Zelle in der Ursprungsdatei.
Vor dem Speichern wird geprüft, ob besagte neue Datei in dem bestimmten Ordner schon vorhanden ist und der user den Vorgang daher abbrechen möchte.
Die gespeicherte neue Datei wird schliesslich geöffnet und die Ursprungsdatei ohne zu speichern geschlossen.

Der nachfolgende code funktioniert bis auf eine Ausnahme:
Befindet sich in dem Ordner schon eine Datei dieses Namens, so wird diese nicht durch Speichern einer Kopie ersetzt, sondern die alte vorhandene Datei geöffnet. Was mache ich falsch?

Beste Grüsse,
Udo

Code:

Sub kopie_speichern()
'
Dim lngCounter As Long, WS As Worksheet

Set WS = ActiveSheet

strFile = "c:\daten\" & "ID " & ActiveSheet.Range("C3") & ".xls"

If Len(Dir(strFile)) > 0 Then
' Datei vorhanden -> rückfrage
i = MsgBox("ID " & ActiveSheet.Range("C3") & " ist bereits vorhanden, überschreiben?", vbYesNo, "Achtung!")
If i = 7 Then
GoTo abbruch
End If
Else
' Datei nicht vorhanden oder vorhanden & überschreiben
ActiveWorkbook.SaveCopyAs strFile
End If

' gespeicherte Datei öffnen und aktivieren
Workbooks.Open "c:\daten\" & "ID " & ActiveSheet.Range("C3") & ".xls"

' wenn aktive Datei nicht "Ursprungsdatei.xls" ist, soll Datei "Ursprungsdatei.xls" geschlossen werden
If ActiveWorkbook.Name "Ursprungsdatei.xls" Then
On Error Resume Next
Workbooks("Ursprungsdatei.xls").Close SaveChanges:=False
If Err Then Exit Sub
End If

abbruch:
Excel.Application.DisplayAlerts = False
Excel.Application.Quit
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

:)

jinx · 18. September 2008

Moin, Udo,

im Falle einer vorhandenen Mappe tut das Makro genau das, was Du vorgegeben hast: bei der Antwort ja nicht die Else-Bedingung durchlaufen *wink.gif*)

Code:

Sub kopie_speichern()
'
Dim lngCounter As Long
Dim strFile As String

strFile = "c:\daten\" & "ID " & ActiveSheet.Range("C3") & ".xls"

If Len(Dir(strFile)) > 0 Then
' Datei vorhanden -> rückfrage
i = MsgBox("ID " & ActiveSheet.Range("C3") & " ist bereits vorhanden, überschreiben?", vbYesNo, "Achtung!")
If i = 7 Then
GoTo abbruch
End If
Else
' Datei nicht vorhanden oder vorhanden & überschreiben
ActiveWorkbook.SaveCopyAs strFile
End If

' gespeicherte Datei öffnen und aktivieren
Workbooks.Open "c:\daten\" & "ID " & ActiveSheet.Range("C3") & ".xls"

' wenn aktive Datei nicht "Ursprungsdatei.xls" ist, soll Datei "Ursprungsdatei.xls" geschlossen werden
ThisWorkbook.Close SaveChanges:=False
If Err Then Exit Sub

abbruch:
Application.DisplayAlerts = False
Application.Quit
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

von VBA-Hilfe Excel97

DisplayAlerts-Eigenschaft
...
Wenn Sie diese Eigenschaft auf False gesetzt haben, setzt Microsoft Excel sie nach Beendigung des Makros nicht automatisch auf True zurück. Ihr Makro sollte die Eigenschaft stets auf True zurücksetzen, wenn es beendet wird.
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Bitte beachten!

terryjak · 19. September 2008

Hi jinx,

Hast natürlich recht. Ich hab jetzt nach "If i=7..." noch nachfolgende Bedingung ergänzt und nun funktioniert es. Danke!
Udo

If i = 6 Then
ActiveWorkbook.SaveCopyAs strFile
End If

Office: Vorhandene Datei durch neue Datei ersetzen

Vorhandene Datei durch neue Datei ersetzen

Vorhandene Datei durch neue Datei ersetzen

Vorhandene Datei durch neue Datei ersetzen - Similar Threads - Vorhandene Datei Datei

Zugriff auf nicht vorhandene Datei seitens Excel

Wert aus Zelle in einer anderen Datei suchen und prüfen, ob weiterer Wert vorhanden ist

Datei vor dem verschieben prüfen, ob vorhanden

Zellinhalt mit Dateien vergleichen ob vorhanden

Speichern unter fragt nicht nach überschreiben bei vorhandener Datei

Datei speichern, vorhandene Datei öffnen und unter neuem Namen speichern

Speichern unter fragt nicht nach überschreiben bei vorhandener Datei