Überprüfen ob Datei/Dateiname schon vorhanden

Daniel · 2008-07-28T19:13:00+00:00

Hallo zusammen, ich versuche mich gerade an meinem ersten größeren VBA-Projekt und komme zurzeit absolut nicht weiter. Versuche vielleicht zu erst einmal mein Projekt zu umschreiben, da ich denke das ist ganz hilfreich. Ich möchte eine Art Mastertabelle erstellen um Berichte von externen Personen ablegen zu können. Die externen Personen bekommen leere Berichtsvorlagen, füllen diese aus und schicken sie mir zurück. Ich speichere die ausgefüllten Excel-Tabellen in dem (Beispiel)Ordner C:\Test\Nicht_Abgelegte_Berichte\ und dem Dateinamen den mir die externen Personen mitschicken... Die Mastertabelle ist mit Makros versehen, welche die einzelnen Excel-Dateien im Ordner C:\Test\Nicht_Abgelegte_Berichte\ durchgeht, die ausgefüllten Felder kopiert, in der Mastertabelle ablegt und die bearbeitete Datei vom Ordner C:\Test\Nicht_Abgelegte_Berichte\ in den Ordner C:\Test\Abgelegte_Berichte\ verschiebt. Nun habe ich Probleme mit der Abfrage, ob evtl. schon eine Datei im "Abgelegte_Berichte Ordner" existiert, die den selben Dateinamen hat, wie die Datei die ich in den Ordner hineinverschieben möchte... Das Programm funktioniert solange, bis eben so eine Datei auftaucht, die von ihrem dateinamen her schon abgelegt ist (nicht aber vom Inhalt)... Nun (endlich) zu meiner Frage... Wie kann ich überprüfen, ob eine Datei, die ich bearbeiten möchte und anschließend in den Ablageordner verschieben möchte, vom Namen her schon im Ablageordner vorhanden ist.. Die Dateien bei denen das der Fall wäre, würde ich gerne umbennen und sie anschließend in den Ablageordner verschieben/speichern und die "alte" Datei mit dem Doppelnamen löschen. Geht das auch eleganter? Habe es auch schon mit FileExists oder dir() versucht, hat aber nicht wirklich geklappt. Weiß hier jemand Rat? Wo muß ich die Abfrage genau einbauen. Ich habe bei meinem Anhang meinen Versuch mal rausgelassen, da es nicht gefunzt hatte. Bisher hatte ich immer das Problem, dass mein Programm sobald ich eine Abfrage eingebaut hatte, nich

Hallo Tino!
Hab es mal versucht.
Klappt aber nicht wirklich...
Es funktioniert beim ersten Durchlauf super.
Nur habe ich in meinem "Noch_Nicht_Abgelegte"-Ordner immer unterschiedlich viele Dateien.
Die Anzahl der Dateien bekomme ich immer exakt ermittelt. Meine For Schleife läuft dann so oft durch, wie ich Anzahl Dateein in dem Ordner habe. So weit so gut. ... Nur sobald die erste Datei gefunden wird, die einen dateinamen besitzt der schon abgelegt ist, hört die Dir() Funktion auf die Namen in dem "Noch_Nicht_Abgelegte"-Ordner durchzugehen. Der Dateiname = Dir(Pfad & Dateiname) zeigt dan als Dateiname ="" an.
Hier mal der entsprechende Quellcode (gekürzt, nur die relevante Abfrage)


Sub text()
Dim Pfad As String, Dateiname As String, iZeile As Long
Dim Pfad_Neu, Dateiname_Neu As String
Pfad = "F:\ALLE\084\Produktmanagement\Anfragemanagement\Ablageordner_Besuchsberichte\ _
Noch_Nicht_Abgelegte_Besuchsberichte\"
Dateiname = Dir$(Pfad & "*.xls")
Pfad_Neu = "F:\ALLE\084\Produktmanagement\Anfragemanagement\Ablageordner_Besuchsberichte\ _
Abgelegte_Besuchsberichte\"
Anzahl = NumberofFilesInDirectory(Pfad, Dateimaske)
For i = 1 To Anzahl
NameMeinerDatei = Dateiname
'Platzhalter der restliche Abfragen und Kopieranweisungen die du in der pdf siehst
'mein Problem liegt aber glaube ich in der Abfrage
FileInQuestion = Dir$(Pfad_Neu & Dateiname, vbNormal)
If FileInQuestion = "" Then
Workbooks(Dateiname).Sheets(1).Protect password:="xxx"
ThisWorkbook.Sheets(2).Protect password:="xxx"
Workbooks(Dateiname).Close
CreateObject("Scripting.FileSystemObject").MoveFile "C:\Test\ _
Nicht_Abgelegte_Berichte\ " & Dateiname, "C:\Test\Abgelegte_Berichte\ " & Dateiname
Else
Workbooks(Dateiname).Sheets(1).Protect password:="xxx"
ThisWorkbook.Sheets(2).Protect password:="xxx"
Set WshShell = CreateObject("WScript.Shell")
WshShell.popup "Folgende Datei existiert schon im Ablageordner: " & Dateiname,  _
2
Neuer_speicher_Name = InputBox("Bitte geben Sie einen neuen, einzigartigen  _
Dateinamen ein")
Dateiname_Neu = (Neuer_speicher_Name & ".xls")
Workbooks(Dateiname).SaveAs Filename:=(Pfad_Neu & Dateiname_Neu)
Workbooks(Dateiname_Neu).Close
Kill (Pfad & Dateiname)
End If
Dateiname = Dir$()
Next
End Sub


Function NumberofFilesInDirectory(Directory, Maske) As Integer
Dim i As Long
With Application.FileSearch
.NewSearch
.LookIn = Directory
.Filename = Maske
NumberofFilesInDirectory = .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending)
End With
End Function

Hoffe auf deine/euere Hilfe, da ich echt nicht mehr weiterkomme.
Im voraus schon mal Vielen Dank!
Gruß Daniel

Hallo Erich!
Ich habe es mal mit deinem Beispiel versucht.
Es klappt auch mit dem Durchgehen der einzelnen Datein super.
Nur mit der If-Abfrage (FileExists) klappt es wie gehabt nicht richtig.
Ich habe bei der Abfrage mal ein boolean-Rückgabe-wert mit eingebaut.
Er gibt mir immer False zurück, auch wenn die Datei mit ihrem Dateinamen schon im Ablageordner besteht...
Kannst dir bitte mal meinen (zusammengepfuschten) Quellcode anschauen, ob dir / euch was auffällt!
Wäre super nett!
Option Explicit
Sub Absoluter_test()
Dim Pfad As String, Dateiname As String, iZeile As Long
Dim Anzahl As Integer, i As Integer
Dim Ueberpruefung As String
Dim c As Variant
Dim WshShell
Dim NameMeinerDatei As String
Dim MeineDatei As Workbook
Dim Neuer_speicher_Name As String
Dim Pfad_Neu, Dateiname_Neu As String
Dim FileInQuestion As String
Dim bFileExists As Boolean
Dim Datei_vorhanden As Boolean
Dim strFile As String
Dim strPfadG As String
Application.ScreenUpdating = False
Application.EnableEvents = False
strPfadG = "F:\Produktmanagement\Anfragemanagement\Ablageordner_Besuchsberichte\"
Pfad = strPfadG & "Noch_Nicht_Abgelegte_Besuchsberichte\"
Pfad_Neu = strPfadG & "Abgelegte_Besuchsberichte\"
Dateiname = Dir$(Pfad & "*.xls")
'Anzahl = NumberofFilesInDirectory(Pfad, Dateimaske)
=While Dateiname > "" 'i = 1 To Anzahl~f~
NameMeinerDatei = Dateiname
On Error Resume Next
Err.Clear
'wir zeigen in die Kolektion der geoeffnetten Dateien
'falls die Datei mit dem Namen NameMeinerDatei in der Kolektion
'existiert, wird es keinen Error geben, falls nicht, gibt es Error Nr.9
Set MeineDatei = Workbooks(NameMeinerDatei)
'Error 9 bedeutet: Subscript out of range, NameMeinerDatei befindet sich nicht in der Kolektion der geoeffnetten Dateien
If (Err.Number = 9) Then
Workbooks.Open Filename:=Pfad & Dateiname
Application.DisplayAlerts = False
Workbooks(Dateiname).Sheets(1).Unprotect password:="xxx"
Ueberpruefung = Workbooks(Dateiname).Sheets(1).Range("d2").text
~f~= If Ueberpruefung <> "Schon abgelegt!" Then
ThisWorkbook.Sheets(2).Unprotect password:="xxx"
iZeile = ThisWorkbook.Sheets(2).Range("A65536").End(xlUp).Offset(1, 0).Row
Workbooks(Dateiname).Sheets(1).Range("b2").Copy
ThisWorkbook.Sheets(2).Cells(iZeile, 1).PasteSpecial Paste:=xlPasteValues
Workbooks(Dateiname).Sheets(1).Range("b6:d6").Copy
ThisWorkbook.Sheets(2).Cells(iZeile, 2).PasteSpecial Paste:=xlPasteValues
Workbooks(Dateiname).Sheets(1).Range("b8:d8").Copy
ThisWorkbook.Sheets(2).Cells(iZeile, 3).PasteSpecial Paste:=xlPasteValues
Workbooks(Dateiname).Sheets(1).Range("b10").Copy
ThisWorkbook.Sheets(2).Cells(iZeile, 4).PasteSpecial Paste:=xlPasteValues
'................wird noch viel mehr kopiert
Workbooks(Dateiname).Sheets(1).Range("a72:d72").Copy
ThisWorkbook.Sheets(2).Cells(iZeile, 44).PasteSpecial Paste:=xlPasteValues
Workbooks(Dateiname).Sheets(1).Unprotect password:="xxx"
Workbooks(Dateiname).Sheets(1).Range("d2").Select
Selection.Merge
Workbooks(Dateiname).Sheets(1).Range("d2").Value = "Schon abgelegt!"
Workbooks(Dateiname).Sheets(1).Range("d2").Interior.ColorIndex = 3
Workbooks(Dateiname).Sheets(1).Range("d2").Font.ColorIndex = 1
ActiveCell.Font.Bold = True
ActiveCell.HorizontalAlignment = xlCenter
ActiveCell.VerticalAlignment = xlCenter
Workbooks(Dateiname).Save
Datei_vorhanden = fso.FileExists(Pfad_Neu & Dateiname)
If Datei_vorhanden = False Then
Workbooks(Dateiname).Sheets(1).Protect password:="xxx"
ThisWorkbook.Sheets(2).Protect password:="xxx"
Workbooks(Dateiname).Save
Workbooks(Dateiname).Close
CreateObject("Scripting.FileSystemObject").MoveFile strPfadG & " Noch_Nicht_Abgelegte_Besuchsberichte\" & Dateiname, strPfad & "Abgelegte_Besuchsberichte\" & Dateiname
Else
Workbooks(Dateiname).Sheets(1).Protect password:="xxx"
ThisWorkbook.Sheets(2).Protect password:="xxx"
Set WshShell = CreateObject("WScript.Shell")
WshShell.popup "Folgende Datei existiert schon im Ablageordner: " & Dateiname, 2
Neuer_speicher_Name = InputBox("Bitte geben Sie einen neuen, einzigartigen Dateinamen ein")
Dateiname_Neu = (Neuer_speicher_Name & ".xls")
Workbooks(Dateiname).SaveAs Filename:=(Pfad_Neu & Dateiname_Neu)
Workbooks(Dateiname_Neu).Close
Kill (Pfad & Dateiname)
End If
Dateiname = Dir$()
Else
Set WshShell = CreateObject("WScript.Shell")
WshShell.popup "Folgende Datei ist schon abgelegt: " & Dateiname, 2
Workbooks(Dateiname).Sheets(1).Protect password:="xxx"
Workbooks(Dateiname).Save
Workbooks(Dateiname).Close
CreateObject("Scripting.FileSystemObject").MoveFile strPfadG & " Noch_Nicht_Abgelegte_Besuchsberichte\" & Dateiname, strPfad & "Abgelegte_Besuchsberichte\" & Dateiname
Dateiname = Dir$()
End If
Else
'................................................................
' Hier steht selbe wie oben, nur die Datei (Dateiname) wäre schon geöffnet...

Überprüfen ob Datei/Dateiname schon vorhanden

Forumthread: Überprüfen ob Datei/Dateiname schon vorhanden

19
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial

Überprüfen, ob eine Datei bereits vorhanden ist und sie gegebenenfalls löschen

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)

Überprüfen ob Datei/Dateiname schon vorhanden

Forumthread: Überprüfen ob Datei/Dateiname schon vorhanden

19 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Infobox / Tutorial

Überprüfen, ob eine Datei bereits vorhanden ist und sie gegebenenfalls löschen

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)

19
Beiträge zum Forumthread

Beiträge zu diesem Forumthread