Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
996to1000
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

Überprüfen ob Datei/Dateiname schon vorhanden

Überprüfen ob Datei/Dateiname schon vorhanden
28.07.2008 19:13:00
Daniel
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, nicht mehr die Dateien hochgezählt hat (dir()), sondern immer dieselbe Datei eingelesen hat.
Ich würde mich wirklich super freuen über Tipps für befehle oder functions etc. die ich für mein Problem verwenden könnte.
mfg Daniel
https://www.herber.de/bbs/user/54181.zip

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

Betreff
Datum
Anwender
Anzeige
AW: Überprüfen ob Datei/Dateiname schon vorhanden
28.07.2008 20:43:32
Tino
Hallo,
hier mal ein Hinweis.

'Beispiel
'sFilename = Pfad + Datei (String)
If Dir$(sFilename, vbNormal)  "" Then
'Datei ist vorhanden.
Kill sFilename 'Datei löschen
Else
'Datei ist nicht vorhanden
End If


Gruß Tino

www.VBA-Excel.de


Hinweis
28.07.2008 20:51:00
Tino
Hallo,
Tipp, stell lieber eine Exceldatei mit dem Code hier rein, mit der PDF kann ich ohne weiteres nichts anfangen, kann noch nicht einmal den Code vollständig kopieren ohne irgendwelche ungewollten Zusätze drin zu haben, da brauch ich erst mal eine halbe stunde um den Code lauffähig zu bekommen.
Gruß Tino

www.VBA-Excel.de


Anzeige
AW: Überprüfen ob Datei/Dateiname schon vorhanden
29.07.2008 06:55:27
Daniel
Vielen Dank erst mal für deine super schnelle Antwort Tino.
Werde es heute gleich mal versuchen. Hoffe es klappt...
Und danke für deinen Tipp, werde ich beim nächsten mal befolgen...
Gruß Daniel

AW: Überprüfen ob Datei/Dateiname schon vorhanden
29.07.2008 09:03:00
Daniel
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

Anzeige
AW: Überprüfen ob Datei/Dateiname schon vorhanden
29.07.2008 09:53:24
Tino
Hallo,
nach meinem Verständnis müsste es so gehen?
Nicht getestet

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 Dir$(Pfad_Neu & Dateiname, vbNormal)  "" 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_Neu & Dateiname)
End If
Dateiname = Dir$()
Next
End Sub


Gruß Tino

www.VBA-Excel.de


Anzeige
AW: Überprüfen ob Datei/Dateiname schon vorhanden
29.07.2008 10:09:29
Tino
Hallo,
muss natürlich
If Dir$(Pfad_Neu & Dateiname, vbNormal) = "" Then
heißen
Gruß Tino

AW: Überprüfen ob Datei/Dateiname schon vorhanden
29.07.2008 10:16:00
Daniel
Servus Tino
Mal ne Frage: Weißt du zufällig ob es was ausmacht, wenn ich in dem Ordner in der die Dir() Anweisung die einzelnen Dateien durchgehen soll, während die Schleife durchläuft mit dem kill Befehl eine Datei lösche. Kann es sein das díe Dir() Anweisung dann rumzicken kann?
Und muß das $ Zeichen nach Dir() stehen... Ich verstehe echt nicht wo bei mir der Fehler liegt.
Gibt es eigentlich auch noch andere Möglichkeiten diese Abfrage zu machen (FileExists) oder so.
Wenn ja wie müsste das aussehen. Habe mich daran auch mal mit wenig Erfolg versucht.
Sorry wenn ich dich hier so mit Fragen löchere... Sitz aber gerade echt fest.
Wie gesagt, vielen Dank schon mal für deine Bemühungen!
Gruß Daniel

Anzeige
AW: Überprüfen ob Datei/Dateiname schon vorhanden
29.07.2008 10:40:57
Tino
Hallo,
kann schon sein dass die etwas Zickig ist.
Ein anderer Vorschlag, überschreibe diese Datei einfach mit dem gleichen Namen und du brauchst die nicht zu löschen.
Setze das überschreiben zwischen
Application.DisplayAlerts = False
'Dein Savas
Application.DisplayAlerts = True
damit keine Warnmeldung erscheint
Gruß Tino

www.VBA-Excel.de


AW: Überprüfen ob Datei/Dateiname schon vorhanden
29.07.2008 10:53:00
Daniel
Ja das wäre eine Idee...
Das Problem ist nur, ich kann die eigentlich nicht überschreiben, da sie vom Inhalt her verschieden
sind/sein können und nur den selben Dateinamen haben. Ich versuche mein Glück mal weiter.
Echt Vielen Dank. Freue mich echt über jede Hilfe. Versuche es evtl. doch mal mit dem überschreiben und versuche die bestehende Datei umzubennen.
Werde dich/euch auf dem laufenden halten und hoffe ich kann dich/euch weiter mit Fragen bombardieren..
Merci mal.
Gruß Daniel

Anzeige
AW:?
29.07.2008 11:00:00
Tino
Hallo,
ob du diese jetzt löschst oder überschreibst, kommt doch aufs selbe raus.
Gruß Tino

AW: AW:?
29.07.2008 13:42:35
Daniel
Hi Tino!
Habe es jetzt einigermassen hin bekommen.
Wollte die alte Datei erst löschen wenn ich sie unter einem neuen (einzigartigen) Namen im AblageOrdner gespeichert habe... Weiß nicht genau wie du das gemeint hattest mit dem überschreiben....
Aber mal vielen, vielen Dank für deine Hilfe! Hat mir wirklich geholfen!
Gruß Daniel

AW: Überprüfen ob Datei/Dateiname schon vorhanden
29.07.2008 10:16:00
Erich
Hallo Daniel,
das Problem entsteht, weil du (nach dem Anfangs-Dir() "Dateiname = Dir$(Pfad & "*.xls")"
in einer Schleife Dir()-Ergebnisse abfragst,
zwischendurch aber die Lieferung des nächsten Dateinamens durch eine andere Dir()-Anweisung störst.
VBA such beim Dir() dann eine zweite Datei, die dem Muste der Anweisung
FileInQuestion = Dir$(Pfad_Neu & Dateiname, vbNormal)
entspricht.
Du musst das FileInQuestion = Dir$(Pfad_Neu & Dateiname, vbNormal)
durch eine Nicht-Dir()-Abfrage ersetzen.
So könnte es funzen (ungetestet):

Option Explicit         ' immer zu empfahlen!
Sub text2()
Dim Pfad As String, Dateiname As String, iZeile As Long
Dim Pfad_Neu, Dateiname_Neu As String, strPfadG As String
Dim FSO As Object, WshShell As Object, Neuer_speicher_Name As String
strPfadG = _
"F:\ALLE\084\Produktmanagement\Anfragemanagement\Ablageordner_Besuchsberichte\"
Pfad = strPfadG & "Noch_Nicht_Abgelegte_Besuchsberichte\"
Pfad_Neu = strPfadG & "Abgelegte_Besuchsberichte\"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WshShell = CreateObject("WScript.Shell")
Dateiname = Dir$(Pfad & "*.xls")
While Dateiname > ""
'     NameMeinerDatei = Dateiname   '  wozu?
'Platzhalter der restliche Abfragen und Kopieranweisungen die du in der pdf siehst
'FileInQuestion = Dir$(Pfad_Neu & Dateiname, vbNormal)
If Not FSO.FileExists(Pfad_Neu & Dateiname) 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 Pfad_Neu & Dateiname_Neu
Workbooks(Dateiname_Neu).Close
Kill Pfad & Dateiname
End If
Dateiname = Dir$()
Wend
End Sub

Wie du siehst, habe ich dir For-Schleife auch gleich wierdser durch While ... ersetzt.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Anzeige
AW: Überprüfen ob Datei/Dateiname schon vorhanden
29.07.2008 10:48:23
Daniel
Hallo Erich
Erst mal super vielen Dank für deine Hilfe!
Ganz kurz noch für mich zum verständnis...
Not Fso.FileExists() hier müsste doch bei then den Fall eintreten lassen, wenn keine Datei mit schon vorhandenem Namen gefunden wird. Ist bei mir aber nicht der Fall...
2. Frage wäre gewesen warum du die for durch eine while schleife ersetzt hast? Besser?
Ich versuche es mit deinem Anstaz gleich noch ein wenig weiter und schaue mal, ob ich noch irgendwo einen Fehler finde...
Ich werde mich auf jeden Fall nochmal melden und bescheid geben, hoffentlich habe ich dann einen Erfolg zu verbuchen...
PS: Kannst ruhig deine VBA Kenntnisse etwas hochschrauben... Ansonsten muss ich glaube ich meine 2 Stufen runtersetzen...;-)
Gruß Daniel

Anzeige
AW: Überprüfen ob Datei/Dateiname schon vorhanden
29.07.2008 12:14:12
Erich
Hi Daniel,
teste das doch einmal in einer einfachen, reduzierten Prozedur.
Daran kannst du erkennen, ob jeweils das richtige Verzeichnis durchsucht wird:

Sub text3Test()
Dim Pfad As String, Dateiname As String
Dim Pfad_Neu, strPfadG As String
Dim FSO As Object
strPfadG = _
"F:\ALLE\084\Produktmanagement\Anfragemanagement\Ablageordner_Besuchsberichte\"
Pfad = strPfadG & "Noch_Nicht_Abgelegte_Besuchsberichte\"
Pfad_Neu = strPfadG & "Abgelegte_Besuchsberichte\"
Set FSO = CreateObject("Scripting.FileSystemObject")
Dateiname = Dir$(Pfad & "*.xls")
While Dateiname > ""
If Not FSO.FileExists(Pfad_Neu & Dateiname) Then
MsgBox Pfad_Neu & Dateiname & " existiert nicht"
Else
MsgBox Pfad_Neu & Dateiname & " existiert"
End If
'                                      ab hier überflüssig, nur zum Testen
If Not FSO.FileExists(Pfad & Dateiname) Then
MsgBox Pfad & Dateiname & " existiert nicht"
Else
MsgBox Pfad & Dateiname & " existiert"
End If
Dateiname = Dir$()
Wend
End Sub

Zu
"Not Fso.FileExists() hier müsste doch bei then den Fall eintreten lassen,
wenn keine Datei mit schon vorhandenem Namen gefunden wird. Ist bei mir aber nicht der Fall..."
Ja, so sollte es aber sein!"
zu 2:
Das While DatNam > "" finde ich einfacher, natürlicher, sprechender.
Du ersparst dir die Ermittlung der Anzahl und brauchst auch keine Schleifenvariable.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Anzeige
AW: Überprüfen ob Datei/Dateiname schon vorhanden
29.07.2008 13:37:00
Daniel
Hallo Erich!
Hey obergeil!
Hat geklappt!
Habe deine Ratschläge mal probiert und einen kleinen Versuchsaufbau gemacht.
Und hier hat es endlich geklappt.
Hoffe jetzt mal, dass ich es auf mein kleines Programm umsetzen kann. Müsste aber klappen....
Wirklich mal vielen, vielen Dank für deine Hilfe.
Falls doch noch etwas nicht klappen sollte würde ich dich nochmal mit Fragen löchern.
Achso ganz kurz noch eine Frage:
Was macht eigentlich genau das Set fso = CreateObject("Scripting.FileSystemObject") ganz genau?
Habe ich zwar auch schon mal verwendet, weiß aber ehrlicherweise nicht genau was es ganz genau macht....:-(
Also merci nochmal und viel Grüße nach Kamp-Lintfort
Gruß Daniel

Anzeige
AW: Scripting.FileSystemObject
30.07.2008 08:30:35
Daniel
Morgen Erich!
Danke für deinen Tipp!
Jetzt habe ich das endlich auch mal kapiert!
Das Programm läuft mittlerweile auch super!
Vielen Dank mal noch für deine Tipps!
Waren echt alle wirklich sehr hilfreich!
Grüße nach Kamp-Lintfort

AW: Überprüfen ob Datei/Dateiname schon vorhanden
29.07.2008 12:27:30
Erich
Hi Daniel,
noch eine Ergänzung:
In der Originalprozedur wird "iZeile As Long" nicht mehr gebraucht.
Hinter "Dim Pfad_Neu" fehlt "As String" - dadurch ist Pfad_Neu eine Variant-Variable
(nicht falsch, aber String ist besser).
Zu "VBA-Kenntnisse etwas hochschrauben": Dazu habe ich doch gar nichts geschrieben...
(Das Level setzt nur der Fragesteller, beim Antworten kann man es nicht ändern.)
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

AW: Überprüfen ob Datei/Dateiname schon vorhanden
29.07.2008 13:24:45
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...

13 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige