Datei in Unterordner schieben geht in Hauptordner nicht

Moderator: ModerationP

Datei in Unterordner schieben geht in Hauptordner nicht

Beitragvon wut » 18. Sep 2021, 13:45

Hallo zusammen,

den Code habe ich hier im Forum gefunden, er funktioniert super.

jetzt habe ich ihn etwas umgebaut um auch in den Hauptordner eine Datei zu verschieben.

Code für den Unterordner - der funktioniert - Datei wird verschoben und es kommt keine Fehlermeldung
Code: Alles auswählen
Sub Datei_verschieben4()
'Dieser Code kopiert eine Datei in die Ordnerstruktur der Tabelle nur wenn ich spalte d der gleiche ordnername drinsteht
   Dim Zeilen As Long, Pfad As String, FullPfad As String, i As Long
   Dim Vorlage As String
   
'   Vorlage = "C:\Users\marcu\Desktop\3 Fertig - Kopie\1.txt"
Vorlage = ActiveWorkbook.Path & "\hub.txt"
   
'   hier die zele eingeben mit einem buchstaben wo gesucht werden soll
   Zeilen = Cells(Rows.Count, "a").End(xlUp).Row
     
   Pfad = ActiveWorkbook.Path & "\"
'   Range("B1")
   
   For i = 1 To Zeilen
'   hier die zele eingeben mit einem zahl wo gesucht werden soll

     FullPfad = Pfad & Cells(i, 1) & "\" & Range("w2") & "\"
     
'     If Dir(FullPfad, vbDirectory) <> "" Then
         FileCopy Vorlage, FullPfad & Dir(Vorlage)
     Else
'         MsgBox FullPfad & "   nicht vorhanden"
     
     End If
     
     
   Next i
 End Sub


Code für den Hauptordner - er verschiebt die Datei aber es kommt eine Fehlermeldung - Laufzeitfehler 70 - Zugriff verweigert
Code: Alles auswählen
Sub Datei_verschieben5()
'Dieser Code kopiert eine Datei in die Ordnerstruktur der Tabelle nur wenn ich spalte d der gleiche ordnername drinsteht
   Dim Zeilen As Long, Pfad As String, FullPfad As String, i As Long
   Dim Vorlage As String
   
'   Vorlage = "C:\Users\marcu\Desktop\3 Fertig - Kopie\1.txt"
Vorlage = ActiveWorkbook.Path & "\hub.txt"
   
'   hier die zele eingeben mit einem buchstaben wo gesucht werden soll
   Zeilen = Cells(Rows.Count, "a").End(xlUp).Row
     
   Pfad = ActiveWorkbook.Path & "\"
'   Range("B1")
   
   For i = 1 To Zeilen
'   hier die zele eingeben mit einem zahl wo gesucht werden soll

     FullPfad = Pfad & Cells(i, 1) & "\"
     
'     If Dir(FullPfad, vbDirectory) <> "" Then
         FileCopy Vorlage, FullPfad & Dir(Vorlage)
'     Else
'         MsgBox FullPfad & "   nicht vorhanden"
     
'     End If
     
     
   Next i
 End Sub


was mich nur wundert, es werden die Dateien genauso verschoben wie ich möchte, nur die Fehlermeldung stört.

Hat jemand einen Tipp?

Danke
Marcus
wut
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 395
Registriert: 21. Sep 2005, 11:32

Re: Datei in Unterordner schieben geht in Hauptordner nicht

Beitragvon hddiesel » 18. Sep 2021, 16:48

Hallo wut,

versuche es einmal so (ungetestet), aus meinen Notizen:

ACHTUNG: Warnmeldungen in Excel-Makros unterdrücken.

Bei Fehlern die auftreten, hinterlasse ich dem Anwender im unglücklichen Fall ein Excel,
welches auf einmal keine Warnungen mehr ausgibt.

Dies muss man natürlich auf jeden Fall vermeiden.

Was ich im Code mache, ist eine Seite aber was ich dem Anwender hinterlasse, eine Andere!
Sie ahnen schon, eine Fehlerbehandlung ist absolut notwendig.

Vereinfacht kann diese so aussehen:
Code: Alles auswählen
Sub Datei_verschieben5()
'Dieser Code kopiert eine Datei in die Ordnerstruktur der Tabelle nur wenn ich spalte d der gleiche ordnername drinsteht
    Dim Zeilen As Long, Pfad As String, FullPfad As String, i As Long
    Dim Vorlage As String

    'Am Anfang des Makros
    On Error GoTo DispFehler
    Application.DisplayAlerts = False   'Die Makro- Nachfragen, oder Meldungen abschalten.

'   Vorlage = "C:\Users\marcu\Desktop\3 Fertig - Kopie\1.txt"
    Vorlage = ActiveWorkbook.Path & "\hub.txt"
   
'   hier die zele eingeben mit einem buchstaben wo gesucht werden soll
    Zeilen = Cells(Rows.Count, "a").End(xlUp).Row
     
    Pfad = ActiveWorkbook.Path & "\"
'   Range("B1")
   
    For i = 1 To Zeilen

        'Hier die zelle eingeben mit einer Zahl wo gesucht werden soll
        FullPfad = Pfad & Cells(i, 1) & "\"
     
'        If Dir(FullPfad, vbDirectory) <> "" Then
            FileCopy Vorlage, FullPfad & Dir(Vorlage)

'        Else
'            MsgBox FullPfad & "   nicht vorhanden"
       
'        End If

    Next i

    'Am Ende des Makros:
DispFehler:
    Application.DisplayAlerts = True    'Die Makro- Nachfragen, oder Meldungen wieder einschalten.

 End Sub
Mit freundlichen Grüssen
Karl


BS: Windows 10_64-Bit, MS Office Professional Plus 2016_32-Bit, incl. Microsoft Visual Basic for Applications 7.1
Benutzeravatar
hddiesel
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 4237
Registriert: 17. Feb 2006, 11:40
Wohnort: Deutschland

Re: Datei in Unterordner schieben geht in Hauptordner nicht

Beitragvon wut » 18. Sep 2021, 19:48

@Karl

besten Dank für die Tipps und den Code, aber anscheinend habe ich da ein anderes Problem.

Der erste Code funktioniert super, ich kann auch 20 andere Dateien in den Unterordner schieben, nur nicht in den Zwischenordner.

Wie müsste ich den 1 Code umschreiben um auch in den Hauptordner eine Datei zu verschieben?

Ordnerstruktur -
Hauptordner - lege ich per Hand an
Zwischenordner - dieser wird per Makro erstellt
Unterordner - diese wird per Makro erstellt
Datei in Unterordner verschieben - wird per Makro gemacht und funktioniert super
Datei in Zwischenordner verschieben - sollte per Makro ablaufen - funktioniert nicht

Code zum Zwischenordner erstellen:
Code: Alles auswählen
'     von Marcus Hofpointner
'beide Codes legen Anhand von Namen in der Soalte A einen ORdner in der Struktur an und zu diesem einen Hyperlink

   Option Explicit

Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
    ByVal lpPath As String) As Long

Sub machHyperlinksNurEingeblendete()
    Dim lZeile As Long, lLetzteZeile As Long
    Dim strWurzel As String, strVerzeichnis As String

    'Wurzelverzeichnis festlegen
    strWurzel = ActiveWorkbook.Path & "\" '"C:\Users\papa\Desktop\"

    'Verweis auf Tabellenblatt (evtl. anzupassen)
    With ActiveSheet

        'Letzte benutzte Zeile ermitteln
        lLetzteZeile = .Columns(1).Find("*", , , , xlByRows, xlPrevious).Row

        'Schleife über alle Zeilen (unabhängig, ob ausgeblendet, oder nicht)
        For lZeile = 8 To lLetzteZeile

            'Nur eingeblendete Zeilen
            If Not .Rows(lZeile).Hidden Then

                'Verzeichnis, das angelegt werden soll
                strVerzeichnis = CStr(.Cells(lZeile, 1).Value)

                'Pfad anlegen
                If MakeSureDirectoryPathExists(strWurzel & strVerzeichnis & "\") Then

                    'Hyperlink anlegen
                    .Hyperlinks.Add Anchor:=.Cells(lZeile, 1), _
                        Address:=strWurzel & strVerzeichnis, _
                        ScreenTip:="Öffne " & strVerzeichnis, _
                        TextToDisplay:=strVerzeichnis
                End If
            End If
        Next

    End With
End Sub


Code zum Unterordner erstellen
Code: Alles auswählen
'beide Codes erstellen einen Unterordner

Option Explicit

#If VBA7 Then
 Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
         ByVal lpPath As String) As Long
#Else
 Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
         ByVal lpPath As String) As Long
#End If
   
Sub UnterOrdner_erstellen64bit()
     Dim Zeilen As Long, Pfad As String, FullPfad As String, i As Long
   
     Zeilen = Range("A65536").End(xlUp).Row
     
'     Pfad = Range("B1")
     Pfad = ActiveWorkbook.Path & "\"
     
     For i = 1 To Zeilen
       FullPfad = Pfad & Cells(i, 1) & "\" & Range("w2") & "\"
       Call MakeSureDirectoryPathExists(FullPfad)
     Next i
End Sub


Code zum schieben einer Datei in den Unterordner
Code: Alles auswählen
Sub Datei_verschieben3()
'Dieser Code kopiert eine Datei in die Ordnerstruktur der Tabelle nur wenn ich spalte d der gleiche ordnername drinsteht
   Dim Zeilen As Long, Pfad As String, FullPfad As String, i As Long
   Dim Vorlage As String
   
'   Vorlage = "C:\Users\marcu\Desktop\3 Fertig - Kopie\1.txt"
Vorlage = ActiveWorkbook.Path & "\readme.txt"
   
'   hier die zele eingeben mit einem buchstaben wo gesucht werden soll
   Zeilen = Cells(Rows.Count, "a").End(xlUp).Row
     
   Pfad = ActiveWorkbook.Path & "\"
'   Range("B1")
   
   For i = 1 To Zeilen
'   hier die zele eingeben mit einem zahl wo gesucht werden soll

     FullPfad = Pfad & Cells(i, 1) & "\" & Range("w2") & "\"
     
     If Dir(FullPfad, vbDirectory) <> "" Then
         FileCopy Vorlage, FullPfad & Dir(Vorlage)
     Else
'         MsgBox FullPfad & "   nicht vorhanden"
     
     End If
   Next i
 End Sub


den Code zum verschieben einer Datei in den Zwischenordner habe ich keine Ahnung wie ich den bauen soll?

Kann mir da jemand helfen?

Gruß
Marcus
wut
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 395
Registriert: 21. Sep 2005, 11:32

Re: Datei in Unterordner schieben geht in Hauptordner nicht

Beitragvon Kuwe » 18. Sep 2021, 20:04

Hallo Marcus,

wut hat geschrieben:den Code zum verschieben einer Datei in den Zwischenordner habe ich keine Ahnung wie ich den bauen soll?


Code: Alles auswählen
Name Vorlage As FullPfad & Dir(Vorlage)
Gruß Uwe
Benutzeravatar
Kuwe
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 6639
Registriert: 30. Dez 2003, 18:37

Re: Datei in Unterordner schieben geht in Hauptordner nicht

Beitragvon wut » 18. Sep 2021, 20:16

@Uwe

meinst du diese Zeile in deine ändern?

FileCopy Vorlage, FullPfad & Dir(Vorlage)
wut
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 395
Registriert: 21. Sep 2005, 11:32

Re: Datei in Unterordner schieben geht in Hauptordner nicht

Beitragvon Kuwe » 18. Sep 2021, 20:19

Hallo Marcus,

ja.
Gruß Uwe
Benutzeravatar
Kuwe
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 6639
Registriert: 30. Dez 2003, 18:37

Re: Datei in Unterordner schieben geht in Hauptordner nicht

Beitragvon wut » 19. Sep 2021, 08:07

@UWE

ich habe diesen Code
Code: Alles auswählen
     If Dir(FullPfad, vbDirectory) <> "" Then
         FileCopy Vorlage, FullPfad & Dir(Vorlage)


durch diesen Code ersetzt
Code: Alles auswählen
     If Dir(FullPfad, vbDirectory) <> "" Then
         Name Vorlage As FullPfad & Dir(Vorlage)


jetzt verschiebt er mir diese Datei in den ersten Ordner und somit fehlt sie für den 2ten Ordner und ich bekomme Laufzeitfehler Datei nicht gefunden.

Er sollte sie aber nicht verschieben sondern wie der 1 Code nur kopieren und einfügen, so das ich in jedem Zwischenordner die readme2 drin habe und in jedem Unterordner die readme1 drin habe.

der 1 Code der die readme1 kopiert und perfekt in alle Unterordner kopiert ohne die Datei zu löschen
Code: Alles auswählen
Sub Datei_verschieben3()
'Dieser Code kopiert eine Datei in die Ordnerstruktur der Tabelle nur wenn ich spalte d der gleiche ordnername drinsteht IN DEN UNTERORDNER
   Dim Zeilen As Long, Pfad As String, FullPfad As String, i As Long
   Dim Vorlage As String
   
'   Vorlage = "C:\Users\marcu\Desktop\3 Fertig - Kopie\1.txt"
Vorlage = ActiveWorkbook.Path & "\readme1.txt"
   
'   hier die zele eingeben mit einem buchstaben wo gesucht werden soll
   Zeilen = Cells(Rows.Count, "a").End(xlUp).Row
     
   Pfad = ActiveWorkbook.Path & "\"
'   Range("B1")
   
   For i = 1 To Zeilen
'   hier die zele eingeben mit einem zahl wo gesucht werden soll

     FullPfad = Pfad & Cells(i, 1) & "\" & Range("w2") & "\"
     
     If Dir(FullPfad, vbDirectory) <> "" Then
         FileCopy Vorlage, FullPfad & Dir(Vorlage)
     Else
'         MsgBox FullPfad & "   nicht vorhanden"
     
     End If
   Next i
 End Sub


lasse ich den Code 2x ablaufen 1x mit readme1 und dann mit readme2 - habe ich alle Dateien im Unterordner, er soll sie aber nicht in den Unterordner kopieren sondern 1 Ebene höher.
Vielleicht sollte ich was an der Zeile im 2 Code ändern?

Code: Alles auswählen
     FullPfad = Pfad & Cells(i, 1) & "\" & Range("w2") & "\"


weil in W2 steht der Name der Unterordner drin der ist immer gleich der heißt Archiv, die Namen der Zwischenordner stehen in Spalte A, bloß wie greife ich auf die zu?


gruß
MArcus
wut
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 395
Registriert: 21. Sep 2005, 11:32

Re: Datei in Unterordner schieben geht in Hauptordner nicht

Beitragvon hddiesel » 19. Sep 2021, 08:20

Hallo wut,

geht es hier um eine Sicherungskopie zu erstellen?
Mit freundlichen Grüssen
Karl


BS: Windows 10_64-Bit, MS Office Professional Plus 2016_32-Bit, incl. Microsoft Visual Basic for Applications 7.1
Benutzeravatar
hddiesel
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 4237
Registriert: 17. Feb 2006, 11:40
Wohnort: Deutschland

Re: Datei in Unterordner schieben geht in Hauptordner nicht

Beitragvon wut » 19. Sep 2021, 08:30

@ Karl
nein

ich habe im Hauptordner meine Exceldatei liegen
aus der herraus werden Zwischenordner angelegt und in diesen Zwischenordnern kommen Unterordner rein.
Alles mit Hilfe von euch erstellt und läuft perfekt.

Jetzt geht es um Dateien kopieren und in die jeweiligen Ordner reinzukopieren.

Readme1 soll in die Unterordner - das funktioniert
Readme2 soll in die Zwischenordner - da klappt es gerade nicht.

der Name des Zwischenordners steht in Spalte A im Excel
der Name des Unterordners steht FIX in W2 im Excel

ich kann x Dateien in den Unterordner schieben nur in den Zwischenordner bekomme ich keine rein



Danke Marcus
wut
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 395
Registriert: 21. Sep 2005, 11:32

Re: Datei in Unterordner schieben geht in Hauptordner nicht

Beitragvon hddiesel » 19. Sep 2021, 08:51

Hallo Markus,

lasse dir einmal die gewünschten Pfade anzeigen, vermutlich ist der 2. Pfad nicht OK.
In einer Beispieldatei, kann ich den Variableninhalt prüfen, in dem von dir geposteten Code, kann ich den Inhalt nicht prüfen.
Mit freundlichen Grüssen
Karl


BS: Windows 10_64-Bit, MS Office Professional Plus 2016_32-Bit, incl. Microsoft Visual Basic for Applications 7.1
Benutzeravatar
hddiesel
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 4237
Registriert: 17. Feb 2006, 11:40
Wohnort: Deutschland

Re: Datei in Unterordner schieben geht in Hauptordner nicht

Beitragvon wut » 19. Sep 2021, 09:01

Hallo anbei die Datei
Du hast keine ausreichende Berechtigung, um die Dateianhänge dieses Beitrags anzusehen.
wut
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 395
Registriert: 21. Sep 2005, 11:32

Re: Datei in Unterordner schieben geht in Hauptordner nicht

Beitragvon hddiesel » 19. Sep 2021, 09:48

Hallo Markus,

auf welche Tabelle bezieht sich Cells(i, 1)?
Code: Alles auswählen
FullPfad = Pfad & Cells(i, 1) & "\" & Range("W2") & "\"

Und For i = 1 To...beginnt wirklich mit der Zeile 1?
Code: Alles auswählen
For i = 1 To Zeilen

oder erst ab der Zeile 8
Code: Alles auswählen
For i = 8 To Zeilen

Was soll geschehen, wenn ab der Zeile 8 keine Angaben stehen?
Hier sehe ich dein Problem, darum lasse dir einmal die Pfadangaben im Einzelschritt anzeigen.
Mit freundlichen Grüssen
Karl


BS: Windows 10_64-Bit, MS Office Professional Plus 2016_32-Bit, incl. Microsoft Visual Basic for Applications 7.1
Benutzeravatar
hddiesel
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 4237
Registriert: 17. Feb 2006, 11:40
Wohnort: Deutschland

Re: Datei in Unterordner schieben geht in Hauptordner nicht

Beitragvon wut » 19. Sep 2021, 10:08

@Karl

Bezug und Quelle für alles ist die Tabelle Dokumentenlenkung hier dann W2 für die Unterordner

ab 8 Startet die Überwachung beziehungsweise der Ablauf der Codes

wie das mit den Einzelschritten funktioniert - weis ich nicht wie das geht

Im 1 Code hat er fixe Vorgaben suche in dem Pfad den Ordner mit dem Unterordner und kopiere die Datei rein
Pfad = wo liegt das Worksheet / suche den Zwischenordner (Name in Spalte A) / suche nach dem Unterordner (Name in Zelle W2) füge die Datei ein

im 2 Code sollte er eigentlich das gleiche machen nur ohne die Zuordnung des Unterordners, bloß wie gestallte ich das?

er sollte nach dem Pfad = wo liegt das Worksheet suchen / suchen nach dem Zwischenordner (Name in Spalte A) und hier dann dann die 2te Datei reinkopieren

für jeden Tipp dankbar

Marcus
wut
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 395
Registriert: 21. Sep 2005, 11:32

Re: Datei in Unterordner schieben geht in Hauptordner nicht

Beitragvon hddiesel » 19. Sep 2021, 10:21

Hallo Markus,

den MausCursor in das Makro setzen, dann mit F8 das Makro im Einzelschritt durchgehen,
dabei kannst du dir die Werte der Variable anzeigen lassen, wenn du mit dem Mauszeiger auf die Variable zeigst.

z.B. die Zeile
Code: Alles auswählen
FullPfad = Pfad & Cells(i, 1) & "\" & Range("W2") & "\"

mit F8 ausführen und danach mit dem Mauszeiger auf FullPfad zeigen.
Anschließend mit F8 weiter, bis zu wiederholten ausführung von
Code: Alles auswählen
FullPfad = Pfad & Cells(i, 1) & "\" & Range("W2") & "\"
Mit freundlichen Grüssen
Karl


BS: Windows 10_64-Bit, MS Office Professional Plus 2016_32-Bit, incl. Microsoft Visual Basic for Applications 7.1
Benutzeravatar
hddiesel
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 4237
Registriert: 17. Feb 2006, 11:40
Wohnort: Deutschland

Re: Datei in Unterordner schieben geht in Hauptordner nicht

Beitragvon wut » 19. Sep 2021, 15:00

@Karl

Code: Alles auswählen
FullPfad = Pfad & Cells(i, 1) & "\" & Range("W2") & "\"


ja diese Zeile vermute ich auch als Ursache, nur wie umschreiben?
wut
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 395
Registriert: 21. Sep 2005, 11:32

Nächste

Zurück zu Excel Forum (provisorisch)

Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 22 Gäste