Autor
|
Thema: Dateien kopieren (1815 mal gelesen)
|
hotstaks2005 Mitglied Elektriker
Beiträge: 142 Registriert: 03.07.2008 EPLAN 5.7 Office 2003
|
erstellt am: 08. Dez. 2009 10:44 <-- editieren / zitieren --> Unities abgeben:
Hi @ll, bei diesem Makro - hier aus dem Forum - werden vorhandene Dateien in neue Ordner kopiert. Klappt grundsätzlich hervorragend! Ein Problem hab ich damit, wenn es eine zu kopierende Datei (noch) nicht gibt. Kann ich das Fehler zu kopierender Dateien übergehen? Also Abarbeitung der nächsten Zeile? Danke für eure Hilfe Sub PDFCopy() Dim Quelle As String, Ziel As String Dim i As Integer For i = 3 To ActiveSheet.Range("E2").CurrentRegion.Rows.Count ' - 2 'Ueberschriften abziehen Quelle = Range("D" & i) 'Ursprung festlegen Debug.Print "Quelle: " & Range("D" & i).Address(0, 0) & " - " & Quelle 'Strg+G fuer Direktbereich! Ziel = Range("E" & i) 'Ziel festlegen Debug.Print "Ziel: " & Range("E" & i).Address(0, 0) & " - " & Ziel FileCopy Quelle, Ziel Next i End Sub ------------------ Immer wieder neu lernen Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Beverly Mitglied Dipl.-Geologe (Rentner)
Beiträge: 394 Registriert: 11.08.2007
|
erstellt am: 08. Dez. 2009 12:58 <-- editieren / zitieren --> Unities abgeben: Nur für hotstaks2005
Hi, wie ist das zu verstehen: die Datei gibt es noch nicht? Ich nehme an, sie sind in Spalte D alle aufgelistet und die betreffende Zelle in Spalte D ist deshalb noch leer? In diesem Fall musst du nur prüfen, ob die laufende Zelle leer ist: Code: If Range("D" & i) <> "" Then Quelle = Range("D" & i) 'Ursprung festlegen Debug.Print "Quelle: " & Range("D" & i).Address(0, 0) & " - " & Quelle 'Strg+G fuer Direktbereich! Ziel = Range("E" & i) 'Ziel festlegen Debug.Print "Ziel: " & Range("E" & i).Address(0, 0) & " - " & Ziel FileCopy Quelle, Ziel End If
Wenn du alles Debug.Print weglässt (da es für die eigentliche Ausführung des Codes überflüssig ist), kannst du den gesamten Teil meines Erachtens auf diese Zeile reduzieren: Code: If Range("D" & i) <> "" Then FileCopy Range("D" & i), Range("E" & i)
------------------ Bis später, Karin Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
hotstaks2005 Mitglied Elektriker
Beiträge: 142 Registriert: 03.07.2008 EPLAN 5.7 Office 2003
|
erstellt am: 08. Dez. 2009 13:01 <-- editieren / zitieren --> Unities abgeben:
Hi danke für deine Antwort. Hab jetzt mal selber was rausgefunden - Neuer Code: Passt jetzt - Grüße Wolfgang Sub PDFCopy() Dim Quelle As String, Ziel As String Dim i As Integer On Error Resume Next For i = 3 To ActiveSheet.Range("E2").CurrentRegion.Rows.Count ' - 2 'Ueberschriften abziehen Quelle = Range("D" & i) 'Ursprung festlegen Debug.Print "Quelle: " & Range("D" & i).Address(0, 0) & " - " & Quelle 'Strg+G fuer Direktbereich! Ziel = Range("E" & i) 'Ziel festlegen Debug.Print "Ziel: " & Range("E" & i).Address(0, 0) & " - " & Ziel FileCopy Quelle, Ziel Next i End Sub
------------------ Immer wieder neu lernen Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
hotstaks2005 Mitglied Elektriker
Beiträge: 142 Registriert: 03.07.2008 EPLAN 5.7 Office 2003
|
erstellt am: 08. Dez. 2009 13:11 <-- editieren / zitieren --> Unities abgeben:
Kurz zum Verständnis. .....Ich nehme an, sie sind in Spalte D alle aufgelistet und die betreffende Zelle in Spalte D ist deshalb noch leer?.... Alle Zeilen sind gefüllt; Problem ist das nicht hinter jeder Zeile auch eine Datei vorhanden ist. Dateinamen werden aus Bestellbezeichnungen und weiteren Texten autom. zusammengesetzt. Es erfolgte daher eine Fehlermeldung beim Versuch eine nicht vorhandene Datei zu kopieren. Mit "On Error Resume Next" läuft der Code jetzt durch und kopiert die vorhandenen Dateien. Danke Wolfgang ------------------ Immer wieder neu lernen Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Beverly Mitglied Dipl.-Geologe (Rentner)
Beiträge: 394 Registriert: 11.08.2007
|
erstellt am: 08. Dez. 2009 13:16 <-- editieren / zitieren --> Unities abgeben: Nur für hotstaks2005
Hi Wolfgang, mit On Error Resume Next sollte man sehr vorsichtig umgehen und nur dann Fehler auf diesem Weg umgehen, wenn keine andere Fehlerbehandlung möglich ist - diese Befehlszeile überspringt nämlich jeglichen auftretenden Fehler und kann somit - insbesondere bei umfangreichen Codes - zu völlig falschen Ergebnissen führen (vielleicht nicht in deiner kokreten Arbeitsmappe, aber ganz allgemein). In deinem Fall ist aber dennoch eine ordnungsgemäße Fehlerbehandlung möglich (siehe meinen Code-Vorschlag) ------------------ Bis später, Karin Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Beverly Mitglied Dipl.-Geologe (Rentner)
Beiträge: 394 Registriert: 11.08.2007
|
erstellt am: 08. Dez. 2009 13:24 <-- editieren / zitieren --> Unities abgeben: Nur für hotstaks2005
Hi Wolfgang, auch in dem Fall, dass die Zellen in Spalte D nicht leer sind sondern nur die aufgeführte Datei noch nicht erstellt wurde, kann man eine Fehlerbehandlung ohne On Error Resume Next durchführen: Code: Dim strDateiname As String If Range("D" & i) <> "" Then strDateiname = Dir("C:\Test\" & Range("D" & i)) If strDateiname <> "" Then FileCopy Range("D" & i), Range("E" & i)
Pfad musst du anpassen und falls der Dateiname ohne Endung aufgelistet ist, musst du ihn im Code noch ergänzen. ------------------ Bis später, Karin Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
hotstaks2005 Mitglied Elektriker
Beiträge: 142 Registriert: 03.07.2008 EPLAN 5.7 Office 2003
|
erstellt am: 09. Dez. 2009 07:03 <-- editieren / zitieren --> Unities abgeben:
Hallo Karin; Guten Morgen Forum. Besten Dank für deine Hilfestellung. In diesem Fall ist es so das eine Fehlerbehandlung nicht notwendig ist. Mit diesem Makro sollen lediglich vorhandene Dateien von a > b kopiert werden und das klappt jetzt. Danke Wolfgang ------------------ Immer wieder neu lernen Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
CAE-Normal-User Mitglied CAE Planer
Beiträge: 30 Registriert: 04.04.2014 Windows 10 Professional | INTEL Core(TM)i5-440 CPU @ 3.10GHz 64 Bit | 8,00 GB Excel 2003 - Excel 2010 - Excel 2013 Eplan P8 - Elcad - E³-series
|
erstellt am: 21. Nov. 2019 10:00 <-- editieren / zitieren --> Unities abgeben: Nur für hotstaks2005
Hallo Zusammen und einen guten Morgen. Bin auf dieses Makro gestoßen und es funzt prima! Möchte es gerne abändern auf "Verschieben". Leider klappt das nicht so. Geändert FileCopy in FileMove > Fehler: Sub oder Function nicht definiert Hoffe auf eure Unterstützung Sub PDFCopy() Dim Quelle As String, ziel As String Dim i As Integer On Error Resume Next For i = 3 To ActiveSheet.Range("E2").CurrentRegion.Rows.Count ' - 2 'Ueberschriften abziehen Quelle = Range("D" & i) 'Ursprung festlegen Debug.Print "Quelle: " & Range("D" & i).Address(0, 0) & " - " & Quelle 'Strg+G fuer Direktbereich! ziel = Range("E" & i) 'Z iel festlegen Debug.Print "Ziel: " & Range("E" & i).Address(0, 0) & " - " & ziel FileMove Quelle, ziel Next i End Sub
------------------ Immer wieder neu dazu lernen. Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
runkelruebe Moderator Straßen- / Tiefbau
Beiträge: 8075 Registriert: 09.03.2006 MS-Office 365 ProPlus x86 WIN7(x64)
|
erstellt am: 21. Nov. 2019 10:20 <-- editieren / zitieren --> Unities abgeben: Nur für hotstaks2005
|
Beverly Mitglied Dipl.-Geologe (Rentner)
Beiträge: 394 Registriert: 11.08.2007
|
erstellt am: 21. Nov. 2019 11:06 <-- editieren / zitieren --> Unities abgeben: Nur für hotstaks2005
Hi, du kannst sie zuerst kopieren und dann das Original löschen (ungetestet): Code: Dim strDateiname As String If Range("D" & i) <> "" Then strDateiname = Dir("C:\Test\" & Range("D" & i)) If strDateiname <> "" Then FileCopy Range("D" & i), Range("E" & i) Kill Range("D" & i).Value End If
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
CAE-Normal-User Mitglied CAE Planer
Beiträge: 30 Registriert: 04.04.2014 Windows 10 Professional | INTEL Core(TM)i5-440 CPU @ 3.10GHz 64 Bit | 8,00 GB Excel 2003 - Excel 2010 - Excel 2013 Eplan P8 - Elcad - E³-series
|
erstellt am: 21. Nov. 2019 16:14 <-- editieren / zitieren --> Unities abgeben: Nur für hotstaks2005
|