Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1176to1180
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Rückfrage ob SaveAs-Datei existiert

Rückfrage ob SaveAs-Datei existiert
Dietmar
Hallo zusammen,
habe nachfolgenden Code von Sepp erhalten und möchte ihn nicht laienhaft verstümmeln.
Wie kann ich hier eine Pürfung einbauen, ob die SaveAs-Datei bereits existiert.
Wenn ja, soll die Entscheidungsmöglichkeit bestehen, ob der Code fortgesetzt oder abgebrochen werden soll.
Herzlichen Dank vorab!
Dietmar aus Aachen
Option Explicit
Sub DatenViaFormular()
Dim strFile As String, strNewName As String
Dim objWB As Workbook, objWS As Worksheet, objTarget As Worksheet
Dim rng As Range, rngF As Range, rngC As Range
Dim blnOpen As Boolean
Dim lngRow As Long, lngLast As Long, lngN As Long
Dim varResult As Variant
On Error GoTo ErrExit
GMS
ChDrive "C"
ChDir "C:\MLC2010\01_Etally_Originale"
strFile = Application.GetOpenFilename("Excel Dateien (*.xls; *.xlsx; *.xlsm)," & _
"*.xls; *.xlsx; *.xlsm")
If strFile = "Falsch" Or strFile = ThisWorkbook.FullName Then GoTo ErrExit
blnOpen = IsOpen(strFile)
If blnOpen Then
Set objWB = Workbooks(Mid(strFile, InStrRev(strFile, "\") + 1))
Else
Set objWB = Workbooks.Open(strFile)
End If
Set objTarget = objWB.Sheets(1)
For Each objWS In ThisWorkbook.Worksheets
With objWS
Select Case .Name
' >>>>>>>>>> hier Auslesen der Case-Daten für Anfrage weggelassen, da unerheblich  0 Then MsgBox .Number & vbLf & vbLf & .Description, vbExclamation, "Fehler"
End With
GMS True
Set objWB = Nothing
Set objWS = Nothing
Set rng = Nothing
Set rngF = Nothing
Set rngC = Nothing
End Sub
Private Sub GMS(Optional ByVal Modus As Boolean = False)
Static lngCalc As Long
With Application
.ScreenUpdating = Modus
.EnableEvents = Modus
.DisplayAlerts = Modus
.EnableCancelKey = IIf(Modus, 1, 0)
If Not Modus Then lngCalc = .Calculation
If Modus And lngCalc = 0 Then lngCalc = -4105
.Calculation = IIf(Modus, lngCalc, -4135)
.Cursor = IIf(Modus, -4143, 2)
End With
End Sub
Private Function IsOpen(ByVal WBFullName As String) As Boolean
Dim objWB As Workbook
For Each objWB In Application.Workbooks
If objWB.FullName = WBFullName Then
IsOpen = True
Exit For
End If
Next
End Function

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Rückfrage ob SaveAs-Datei existiert
08.09.2010 20:27:15
Rudi
Hallo,
...
Application.Calculation = xlCalculationAutomatic 'neu ab 31.08.2010
If Dir("C:\MLC2010\02_Etally_Archiv" & "\" & strNewName) = "" Then
objWB.SaveAs "C:\MLC2010\02_Etally_Archiv" & "\" & strNewName 'Speichern unter vorgegebenem  _
Pfad
Else
If MsgBox("Datei existiert schon. Überschreiben?", vbYesNo, "Frage") = vbYes Then
Application.DisplayAlerts = False
objWB.SaveAs "C:\MLC2010\02_Etally_Archiv" & "\" & strNewName
Application.DisplayAlerts = True
Else
MsgBox "Datein nicht gespeichert.", , "Gebe bekannt ..."
End If
End If
objWB.Close
...

Gruß
Rudi
Anzeige
Bleibt bei NEIN hängen
09.09.2010 20:56:06
Dietmar
Hallo Rudi,
vielen Dank für Deine Codeergänzung.
Es läuft prima, wenn ich nach der Feststellung des Codes, dass die Datei bereits existiert, die Frage, ob diese Überschrieben werden soll mit JA beantworte.
Der Code hängt sich aber fast auf, (läuft danach ca. 2 - 3 Minuten), wenn ich auf NEIN klicke.
Der Grund wird wohl sein, dass die mit Daten zu befüllende Datei aus ChDir "C:\MLC2010\01_Etally_Originale" die ja zu diesem Zeitpunkt bereits mit Daten befüllt wurde, um Sie dann unter dem Namennter dem vorgegebenen Namen strNewName (resultiert aus Zellinhalt) bereits geöffnet ist.
Könntest Du den Code noch für den Fall des klicks auf NEIN ergänzen, so dass die Datei wieder geschlossen wird und alles quasi wieder in den Ursprungszustand gesetzt wird.
Vielen Dank
Gruß Dietmar aus Aachen
Anzeige
AW: Rückfrage ob SaveAs-Datei existiert
08.09.2010 20:41:33
andy007
Hallo Dietmar,
hier eine Funktion die prüft ob eine Datei existiert oder nicht.
Function fktCheckIfFileExisting(ByVal strDateiname As String, ByVal strDateiPfad As String) As   _
_
Boolean
Dim intI As Integer
Dim intGefundeneDateien As Integer
Dim strString1 As String
Dim strString2 As String
Dim fs As Object
Set fs = Application.FileSearch
intGefundeneDateien = 0
If Right(strDateiPfad, 1) = "\" Then
strDateiPfad = Left(strDateiPfad, Len(strDateiPfad) - 1)
End If
With fs
.LookIn = strDateiPfad
.Filename = strDateiname
.MatchTextExactly = True
If .Execute(, , True) > 0 Then
For intI = 1 To fs.FoundFiles.Count
strString1 = fs.FoundFiles.Item(intI)
strString2 = strDateiPfad & "\" & strDateiname
If StrComp(strString1, strString2, 1) = 0 Then
intGefundeneDateien = 1
Exit For
End If
Next intI
End If
End With
If intGefundeneDateien = 1 Then
fktCheckIfFileExisting = True
Else
fktCheckIfFileExisting = False
End If
Set fs = Nothing
End Function
Gruß,
Andreas
Anzeige
AW: Rückfrage ob SaveAs-Datei existiert
08.09.2010 20:47:35
fcs
Hallo Dieter,
Mit Dir kannst du vor dem Speichern prüfen, ob die Datei schon vorhanden ist, und die weiteren Aktionen steuern.
Gruß
Franz
Nicht getestet:
  strNewName = "C:\MLC2010\02_Etally_Archiv" & "\" & strNewName
'Prüfen, ob Datei schon existiert
If Dir(strNewName)  "" Then
If MsgBox("Die Datei """ & strNewName & """ existiert schon." _
& vbLf & "Datei trotzdem speichern?", _
vbQuestion + vbYesNo + vbDefaultButton2, _
"In Etally-Archiv speichern") = vbNo Then GoTo ErrExit
End If
End If
objWB.SaveAs strNewName 'Speichern unter vorgegebenem Pfad
objWB.Close
ErrExit:

Anzeige
Geht bei NEIN nicht
09.09.2010 21:08:48
Dietmar
Hallo Franz,
herzlichen Dank für Deine Untersützung.
Leider hängt der Code sich auf wie bei Rudi, wenn ich bei der Abfrage auf NEIN klicke, da irgendwie die geöffnete Datei und/oder die SaveAs-Datei nicht geschlossen wird.
Ich brauchte eine Ergänzung, die alles schließt ohne etwas zu veranlassen.
Bin für jede Hilfe sehr dankbar.
Viele Grüße
Dietmar aus Aachen
AW: Geht bei NEIN nicht
09.09.2010 21:49:26
fcs
Hallo Dietmar,
mit folgender Ergänzung wird bei "Nein" die zuvor geöffnete Datei ohne zu speichern geschlossen.
Gruß
Franz
    strNewName = "C:\MLC2010\02_Etally_Archiv" & "\" & strNewName
'Prüfen, ob Datei schon existiert
If Dir(strNewName)  "" Then
If MsgBox("Die Datei """ & strNewName & """ existiert schon." _
& vbLf & "Datei trotzdem speichern?", _
vbQuestion + vbYesNo + vbDefaultButton2, "In Etally-Archiv speichern") = vbNo Then
objWB.Close Savechanges:=False
GoTo ErrExit
End If
End If
objWB.SaveAs strNewName 'Speichern unter vorgegebenem Pfad
objWB.Close
ErrExit:

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige