Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
932to936
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
932to936
932to936
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Vor dem Dateikopieren prüfen ob Datei bereits vorh

Vor dem Dateikopieren prüfen ob Datei bereits vorh
13.12.2007 20:08:00
Kasimir
Hallo Leute,
ich benötige mal wieder Eure Hilfe.
Mit nachfolgendem Code kopiere ich Daten von einem Pfad, der in einem Dialogfenster ausgewählt werden kann, in ein feststehendes Verzeichnis. Das funktioniert auch super. Hier erst mal das Makro:

Sub Listen_kopieren()
Dim PfadZiel As String
Dim Zähler As Integer
Dim Pfad As String
Dim DirDatei As String
If Workbooks(WorkbookName).Sheets("Hilfstabelle").Range("AY3") = "" Then _
PfadZiel = Mid(ThisWorkbook.path, 1, Len(ThisWorkbook.path) - 8) & "Preislisten"
If Workbooks(WorkbookName).Sheets("Hilfstabelle").Range("AY3")  "" Then _
PfadZiel = Workbooks(WorkbookName).Sheets("Hilfstabelle").Range("AY3")
Pfad = GetDirectory("Bitte Ordner auswählen, aus dem die Objektlisten kopiert werden soll.")
'Wenn Abbruch-Taste betätigt wird, Prozedur beenden
If Pfad = "" Then Exit Sub
'Backslash am Ende des Pfades anfügen wenn fehlt
If Right(Pfad, 1)  "/" Then _
Pfad = Pfad & "\"
'Backslash am Ende des Pfades anfügen wenn fehlt
If Right(PfadZiel, 1)  "/" Then _
PfadZiel = PfadZiel & "\"
If Pfad = PfadZiel Then
MsgBox "Bei dem ausgesuchten Pfad handelt es sich um den Pfad, in das die Objektlisten kopiert " _
_
& "werden. Der Vorgang wird abgebrochen", vbInformation, "Immorente - Abbruch..."
Exit Sub
End If
'----------------------------------------------------------------------------------------------- _
'Prüfen ob ausgewähltes Verzeichnis Objektlisten enthält
Zähler = 0
DirDatei = Dir(Pfad & "*.xls")
Do While DirDatei  ""
If LCase(Left(DirDatei, 15)) = "stellplatzliste" Or LCase(Left(DirDatei, 7)) = "objekt_" Then
Zähler = Zähler + 1
End If
DirDatei = Dir()
Loop
If Zähler = 0 Then
MsgBox "Unter dem von Ihnen ausgewähltem Pfad wurde keine Objekt- oder Stellplatzlisten  _
gefunden. " _
& "Es wurden keine Daten kopiert.", vbInformation, "Immorente - Datenimport fehlgeschlagen..."
Exit Sub
End If
'----------------------------------------------------------------------------------------------- _
'Objektlisten kopieren
Zähler = 0
DirDatei = Dir(Pfad & "*.xls")
Do While DirDatei  ""
If LCase(Left(DirDatei, 15)) = "stellplatzliste" Or LCase(Left(DirDatei, 7)) = "objekt_" Then
FileCopy Pfad & DirDatei, PfadZiel & DirDatei
Zähler = Zähler + 1
End If
DirDatei = Dir()
Loop
If Zähler > 0 Then
MsgBox "Es wurden " & Zähler & " Objekt- und Stellplatzlisten erfolgreich " _
& "importiert.", vbInformation, "Immorente - Datenimport..."
End If
End Sub


Allerdings wäre es nun noch schön, wenn vor dem Kopieren geprüft würde, ob die zu kopierende Datei bereits in dem Verzeichnis vorhanden ist. Wenn ja, soll die Datei nicht kopiert werden. Gibt es die Datei noch nicht, soll sie kopiert werden. Ich habe es mit einer 2. Do/Loop-Anweisung versucht, allerdings funktionierte das nicht. Hat jemand eine Idee, wie ich das realisieren kann?
Danke Euch schon mal,
Kasimir

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Vor dem Dateikopieren prüfen ob Datei bereits vorh
13.12.2007 20:10:40
Hajo_Zi
Hallo Kasimir,
das Forum hat auch eine Suchfunktion.

Option Explicit
Sub Vorhanden_Datei()
'   Fehler falls LW nicht vorhanden
If Dir("L:\Eigene Dateien\Hajo\Adresse1.xls") Then
MsgBox "vorhanden"
Else
MsgBox "nicht vorhanden"
End If
End Sub
Sub Datei_vorhanden()
'   von Berti Koern
Dim Fso, Dateiname
Set Fso = CreateObject("Scripting.FileSystemObject")
Dateiname = "D:\Eigene Dateien\Hajo\Adresse.xls"
'   Egänzung öffnung Hajo
If Fso.FileExists(Dateiname) Then
Workbooks.Open Dateiname
End If
End Sub
Sub Vorhanden_Phad()
'   Fehler falls LW nicht vorhanden
If Dir("C:\Eigene Dateien\")  "" Then
MsgBox "vorhanden"
Else
MkDir "C:\Eigene Dateien\"
MsgBox "nicht vorhanden"
End If
End Sub
Sub Ordner_vorhanden()
'   von Berti Koern
Dim Fso, Ordnername
Set Fso = CreateObject("Scripting.FileSystemObject")
Ordnername = "C:\Eigene Dateien\"
'    MsgBox Fso.FolderExists(Ordnername)
If Fso.FolderExists(Ordnername) = False Then MkDir "C:\Eigene Dateien\"
End Sub



Anzeige
AW: Vor dem Dateikopieren prüfen ob Datei bereits vorh
13.12.2007 20:31:49
Kasimir
Hallo Hajo,
danke Dir für Deine Antwort. Leider hilft sie mir nicht so recht weiter. Verwende ich "If Dir(......) Then" erhalte ich eine Fehlermeldung. Verwende ich Fso.FileExists(.....) werden trotzedem alle Daten kopiert. Egal ob vorhanden oder nicht. Hier nochmal mein Makro mit Fso.FileExists(....) :

Sub Listen_kopieren()
Dim PfadZiel As String
Dim Zähler As Integer
Dim Pfad As String
Dim DirDatei As String
Dim Fso
Set Fso = CreateObject("Scripting.FileSystemObject")
If Workbooks(WorkbookName).Sheets("Hilfstabelle").Range("AY3") = "" Then _
PfadZiel = Mid(ThisWorkbook.path, 1, Len(ThisWorkbook.path) - 8) & "Preislisten"
If Workbooks(WorkbookName).Sheets("Hilfstabelle").Range("AY3")  "" Then _
PfadZiel = Workbooks(WorkbookName).Sheets("Hilfstabelle").Range("AY3")
Pfad = GetDirectory("Bitte Ordner auswählen, aus dem die Objektlisten kopiert werden soll.")
'Wenn Abbruch-Taste betätigt wird, Prozedur beenden
If Pfad = "" Then Exit Sub
'Backslash am Ende des Pfades anfügen wenn fehlt
If Right(Pfad, 1)  "/" Then _
Pfad = Pfad & "\"
'Backslash am Ende des Pfades anfügen wenn fehlt
If Right(PfadZiel, 1)  "/" Then _
PfadZiel = PfadZiel & "\"
If Pfad = PfadZiel Then
MsgBox "Bei dem ausgesuchten Pfad handelt es sich um den Pfad, in das die Objektlisten kopiert " _
_
& "werden. Der Vorgang wird abgebrochen", vbInformation, "Immorente - Abbruch..."
Exit Sub
End If
'---------------------------------------------------------------------------------------------- _
'Prüfen ob ausgewähltes Verzeichnis Objektlisten enthält
Zähler = 0
DirDatei = Dir(Pfad & "*.xls")
Do While DirDatei  ""
If LCase(Left(DirDatei, 15)) = "stellplatzliste" Or LCase(Left(DirDatei, 7)) = "objekt_" Then
Zähler = Zähler + 1
End If
DirDatei = Dir()
Loop
If Zähler = 0 Then
MsgBox "Unter dem von Ihnen ausgewähltem Pfad wurde keine Objekt- oder Stellplatzlisten  _
gefunden. " _
& "Es wurden keine Daten kopiert.", vbInformation, "Immorente - Datenimport fehlgeschlagen..."
Exit Sub
End If
Zähler = 0
DirDatei = Dir(Pfad & "*.xls")
Do While DirDatei  ""
If LCase(Left(DirDatei, 15)) = "stellplatzliste" Or LCase(Left(DirDatei, 7)) = "objekt_" Then
If Fso.FileExists(PfadZiel & DirDatei) Then
FileCopy Pfad & DirDatei, PfadZiel & DirDatei
Zähler = Zähler + 1
End If
End If
DirDatei = Dir()
Loop
If Zähler > 0 Then
MsgBox "Es wurden " & Zähler & " Objekt- und Stellplatzlisten erfolgreich " _
& "importiert.", vbInformation, "Immorente - Datenimport..."
End If
End Sub


Habe ich da etwas verkehrt gemacht?
Danke nochmal,
Kasimir

Anzeige
AW: Vor dem Dateikopieren prüfen ob Datei bereits vorh
13.12.2007 20:38:14
Horst
Hi,
das ist kein Backslash, oder?
If Right(Pfad, 1) "/" Then
mfg Horst

AW: Vor dem Dateikopieren prüfen ob Datei bereits vorh
13.12.2007 20:44:47
Kasimir
Hallo Horst,
das ist mir noch garnicht aufgefallen. Du hast recht. Werde ich ändern. Allerdings funktionierts trotzdem nicht.
Jemand eine Idee, was in meinem Makro verkehrt ist?
Danke,
Kasimir

AW: Vor dem Dateikopieren prüfen ob Datei bereits vorh
14.12.2007 05:23:10
Kasimir
Hallo an alle,
ich habe es alleine herausbekommen, warum mein Makro in Antwort 2 nicht das machte, was ich eigentlich wollte. Anstelle von
If Fso.FileExists(PfadZiel & DirDatei) Then
FileCopy Pfad & DirDatei, PfadZiel & DirDatei
Zähler = Zähler + 1
End If
muss es
If Fso.FileExists(PfadZiel & DirDatei) = False Then
FileCopy Pfad & DirDatei, PfadZiel & DirDatei
Zähler = Zähler + 1
End If
lauten. Dann funktioniert’s.
Gruß,
Kasimir
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige