Office: Daten abgleichen Ordner Unterordner

Helfe beim Thema Daten abgleichen Ordner Unterordner in Microsoft Excel Hilfe um das Problem gemeinsam zu lösen; Hallo, habe das schon in einem anderen Forum gepostet, die Lösung von mase verstehe ich nicht! Das Problem: Ich möchte Zellen aus einer Tabelle mit... Dieses Thema im Forum "Microsoft Excel Hilfe" wurde erstellt von Hans2020, 23. Februar 2020.

  1. Daten abgleichen Ordner Unterordner


    Hallo,

    habe das schon in einem anderen Forum gepostet, die Lösung von mase verstehe ich nicht!

    Das Problem:

    Ich möchte Zellen aus einer Tabelle mit Dateinamen aus einem Ordner und Unterordnern vergleichen und sollten sie übereinstimmen wird die Datei in einen Zielordner kopiert. Das Beispiel aus dem Netz funktioniert auch soweit und konnte auf meine Bedürfnisse umgeschrieben werden.

    Wie beziehe ich in diesem Beispiel mögliche Unterordner ein? Wenn eine Name der Liste nicht als Datei vorhanden ist soll er nicht aus dem Programm aussteigen, sondern die Liste weiter abarbeiten!

    Den Quell- und Zielpfad habe ich für mich so gestaltet, dass er von einer Range, zB. C8 übernommen wird. das funzt auch! Hier ist das leicht geänderte Beispiel, das ich nicht so hinbekommen, also Unterordner abgleichen und bei nicht vorhandener Datei weiter abarbeiten

    Es wäre super wenn mir jemand helfen könnte! DANKE!




    Sub Test()
    Dim i As Long
    Dim myFSo As Object
    Dim sPath As String
    Dim sPath2 As String

    sPath = Worksheets("TEST").Range("C8")
    sPath2 = Worksheets("TEST").Range("C9")

    With Worksheets("NEU")
    Const sSpalte As Long = 1



    For i = 1 To Cells(Rows.Count, sSpalte).End(xlUp).Row
    'ist zelleninhalt vorhanden
    If Cells(i, sSpalte) > "" Then
    'ist datei im angegebenen Ordner vorhanden


    If Dir(sPath & Cells(i, sSpalte)) > "" Then

    Set myFSo = CreateObject("Scripting.FileSystemObject")

    myFSo.CopyFile sPath & Cells(i, sSpalte) sPath2 & Cells(i, sSpalte) , True


    End If
    End If


    Next i


    End With
    End Sub

    Habe im Netz diese Lösung gefunden! Geht bei mir aber nicht!





    If FindFile(sPath & Cells(i, sSpalte) ) > "" Then

    Gibt er aus: Argument ist nicht optional

    Option Explicit

    Dim FSO, FO, FU, F

    Sub Dateien_prüfen()
    Dim i As Long ' Zählwert für Reihe
    Const sPath As String = "D:a.noackDev" '"C:UsersfritzDocumentsBeruf" 'ANPASSEN
    Const sSpalte As Long = 1 'Spalte 1 im Reparaturbuch

    'Alle Zellen der angebenen Spalte durchlaufen
    For i = 1 To Cells(Rows.Count, sSpalte).End(xlUp).Row
    'Ist ein Zelleninhalt vorhanden?
    If Cells(i, sSpalte) > "" Then
    'Ist die Datei im angegebenen Ordner vorhanden?
    If FindFile(sPath, Cells(i, sSpalte) & ".xls") > "" Then
    'wenn ja, dann Zeile grau hinterlegen
    Cells(i, 1).EntireRow.Interior.ColorIndex = 15
    Else
    'wenn nein, dann Zeile rot hinterlegen
    Cells(i, 1).EntireRow.Interior.ColorIndex = 0
    'Cancel = True
    End If
    End If
    Next i
    End Sub


    Public Function FindFile(sPath As String, sFile As String) As String
    Set FSO = CreateObject("Scripting.FileSystemObject")

    FindFile = GetSubFolders(sPath, sFile)
    End Function

    Private Function GetSubFolders(sPath As String, sFile As String) As String
    On Error GoTo errHandler

    Set FO = FSO.GetFolder(sPath)
    Set FU = FO.SubFolders

    On Error Resume Next

    For Each F In FU
    If Dir(F.Path & "" & sFile) > "" Then
    GetSubFolders = F.Path
    Exit For
    End If

    GetSubFolders F.Path, sFile
    Next

    Exit Function

    errHandler:
    GetSubFolders = ""
    End Function

    :)
     
    Hans2020, 23. Februar 2020
    #1
  2. Hallo Hans2020,

    das hatte Ich bereits im anderen Forum.
    Warum versucht Du nicht Deine Prüfung und das Kopieren einzubauen?

    Code:
    X-Post
     
  3. Hola,

    edit: obsolet.

    Gruß,
    steve1da
     
    steve1da, 25. Februar 2020
    #3
  4. Daten abgleichen Ordner Unterordner

    Weil ich es nicht verstehe! Sorry!

    Warum geht denn die andere Lösung aus dem Netz bei mir nicht? Die passt doch zu meinem Grundgerüst?
     
    Hans2020, 25. Februar 2020
    #4
  5. If FindFile(sPath & Cells(i, sSpalte) ) > "" Then

    Argument ist nicht optional ist die Fehlermeldung!
     
    Hans2020, 25. Februar 2020
    #5
  6. Hat keiner einen Tipp für mich?
     
    Hans2020, 25. Februar 2020
    #6
  7. So! Jetzt geht es!

    Aber das Makro macht nicht was es soll! Jetzt durchsucht es die Unterordner und gleicht die Dateien ab! Diese werden in der Tabelle auch grau hinterlegt! Die Dateien der Hauptebene werden nicht grau hinterlegt! Die nicht vorhandenen werden auch nicht rot hinterlegt!

    Was ist nun noch falsch?





    Public Sub TEST()
    Dim Zeile As Long
    Dim ZeileMax As Long
    Dim n As Long
    Dim rngCell As Range
    Dim cDir As String, sListe As String
    Dim i As Long
    Dim myFSo As Object
    Dim x As Long
    Dim lZeile As Long
    Dim lAnzahlDateien As Long
    Dim sPath As String
    Dim sPath2 As String
    Dim k As Long
    Dim strSubFolder As Variant
    Dim sourceFolder As Object, SubFolder As Object, strFilename$, strFilenameOld$, j&
    Dim sFile As String


    ThisWorkbook.Worksheets.Add.Name = "LLL"

    With Worksheets("Test")
    ZeileMax = .UsedRange.Rows.Count
    n = 1
    lZeile = 15



    For Zeile = 2 To ZeileMax

    If .Cells(Zeile, 34).Value = "2" Then

    .Rows(Zeile).Copy Destination:=Worksheets("LLL").Rows(n)
    n = n + 1

    End If
    Next Zeile
    End With

    Worksheets("LLL").Cells.NumberFormat = "@"










    sPath2 = Worksheets("TEST2").Range("C9")
    sPath = Worksheets("TEST2").Range("C8")



    With Worksheets("LLL")
    Const sSpalte As Long = 1
    End With






    sListe = "Datei" & vbCrLf
    'Alle zellen der angebenen Spalte durchlaufen

    For i = 1 To Cells(Rows.Count, sSpalte).End(xlUp).Row
    'ist zelleninhalt vorhanden
    If Cells(i, sSpalte) > "" Then


    If FindFile(sPath, Cells(i, sSpalte) & ".xlsm") > "" Then

    'wenn ja, dann in Meldung ausgeben

    Cells(i, 1).EntireRow.Interior.ColorIndex = 15
    Else
    'wenn nein, dann Zeile rot hinterlegen
    Cells(i, 1).EntireRow.Interior.ColorIndex = 0
    'Cancel = Tru

    End If
    End If



    Next i








    End Sub
    Public Function FindFile(sPath As String, sFile As String) As String
    Set FSO = CreateObject("Scripting.FileSystemObject")

    FindFile = GetSubFolders(sPath, sFile)
    End Function

    Private Function GetSubFolders(sPath As String, sFile As String) As String
    On Error GoTo errHandler

    Set FO = FSO.GetFolder(sPath)
    Set FU = FO.SubFolders

    On Error Resume Next

    For Each F In FU
    If Dir(F.Path & "" & sFile) > "" Then
    GetSubFolders = F.Path
    Exit For
    End If

    GetSubFolders F.Path, sFile
    Next

    Exit Function

    errHandler:
    GetSubFolders = ""
    End Function
     
    Hans2020, 25. Februar 2020
    #7
  8. Daten abgleichen Ordner Unterordner

    Bin am Verzweifeln! Kann keiner helfen? Möchte keiner helfen? Bitte!
     
    Hans2020, 25. Februar 2020
    #8
  9. If FindFile(sPath, Cells(i, sSpalte)) > "" Then

    'wenn ja, dann in Meldung ausgeben

    FileCopy FindFile(sPath, Cells(i, sSpalte)) & Test, sPath2 & Cells(i, sSpalte)

    Warum bricht er nach der ersten Datei ab obwohl später ein Next i kommt
     
    Hans2020, 25. Februar 2020
    #9
  10. Hola,

    nur mal zwischendurch: auf kostenlose Hilfe darf man schon mal etwas warten! Nicht jeder sitzt hier und wartet dass du ein Problem postest - das geschieht nämlich alles freiwillig und in der Freizeit.
    Wenn du natürlich einen Dienstleister beauftragst kannst du so oft nachfragen wie du willst.

    Just my 2 Cents.

    Gruß,
    steve1da
     
    steve1da, 25. Februar 2020
    #10
  11. Ist mir schon klar! Sorry!
     
    Hans2020, 25. Februar 2020
    #11
  12. Moin Hans,

    Ich biete Dir support auf Basis meines Weges an.
    Entweder Du gehst diesen mit oder wartest auf weitere Antworten - Deine Entscheidung -

    My way:
    a) Mach ne Datensicherung Deiner Datei (!)
    b) Nimm diesen Code in ein Modul und führe diesen aus
    c) prüfe im Arbeitsblatt "Meilenstein", ob all die Dateinamen auftauchen, welche Du mit Deiner Liste abgleichen willst und gib Rückmeldung ob iO oder niO


    Code:
     
  13. Daten abgleichen Ordner Unterordner

    Ohh Danke!

    Habe es probiert, den Startpfad geändert! Fehler:

    For Each fldr In fso.GetFolder(sPfad).subFolders
    Pfad nicht gefunden!
     
    Hans2020, 25. Februar 2020
    #13
  14. Jetzt wäre doch interessant, welchen Pfad Du angegeben hast.

    Hinweis:
    \
     
  15. Tja, mein Fehler! Pfad falsch angegeben! Er listet alle Dateien des Pfades und der Unterverzeichnisse auf! Ja! Diese möchte ich mit der Liste abgleichen und nur die kopieren die in der Liste vorhanden sind!
     
    Hans2020, 25. Februar 2020
    #15
Thema:

Daten abgleichen Ordner Unterordner

Die Seite wird geladen...
  1. Daten abgleichen Ordner Unterordner - Similar Threads - Daten abgleichen Ordner

  2. Daten aus Datenbank mit einer Liste abgleichen

    in Microsoft Excel Hilfe
    Daten aus Datenbank mit einer Liste abgleichen: Hallo, bin noch Excelneuling und bräuchte mal Hilfe. Bin dabei für die Firma was zu basteln. Eine Art Erlaubnisschein für Fremdfirmen. Bin schon so weit das die Erlaubnisscheine in eine...
  3. Datensätze aus einer Tabelle mit Daten einer anderen abgleichen

    in Microsoft Excel Hilfe
    Datensätze aus einer Tabelle mit Daten einer anderen abgleichen: Hallo, ich habe zwei Tabellen. 1. Liste ist Personalbestand 2. Liste ist eine gesammelte Teilnehmendenliste von Veranstaltungen ich möchte nun herausfinden, welche Personen an einer...
  4. Daten abgleichen und Ergebnis ausgeben

    in Microsoft Excel Hilfe
    Daten abgleichen und Ergebnis ausgeben: Hallo Werte Gemeinschaft, Ich arbeite bei einem Parkservice und wir stehen vor dem Problem: Es gibt 2 Tabellen. Die erste dokumentiert die eingeparkten Fahrzeuge, die zweite die...
  5. Zellinhalte abgleichen und Daten übernehmen

    in Microsoft Excel Hilfe
    Zellinhalte abgleichen und Daten übernehmen: Hallo Forum, ich habe folgendes Problem und hoffe auf Hilfe... wahrscheinlich ist es eine härtere Nuss. Wir nutzen bei uns ein Programm (Magellan) zur Schulverwaltung. Hieraus kann ich...
  6. daten aus zwei dokumenten abgleichen

    in Microsoft Excel Hilfe
    daten aus zwei dokumenten abgleichen: hallo, ich habe denke ich ein relativ komplexes problem. vorab: nutze einen mac und office 2011. ich habe eine liste mit namen, geburtsdatum (A) und anderen dingen und eine mit namen und...
  7. zwei Tabellen vergleichen - Daten abgleichen und zuordnen?

    in Microsoft Excel Hilfe
    zwei Tabellen vergleichen - Daten abgleichen und zuordnen?: Hallo zusammen ich versuch mal auf diesem Wege weiterzukommmen es geht um 2 Excel Tabellen welche Artikelnummern beinhalten und leider sind diese nicht gleich aufgebaut und nun muss aus der...
  8. Daten abgleichen und doppelte Einträge anzeigen

    in Microsoft Excel Hilfe
    Daten abgleichen und doppelte Einträge anzeigen: Guten Tag, ich benutzte Excel 2003 in der englischen Version und komme nicht weiter. Ich habe beginnend ab A2 XJ00001 XJ00001 XJ00001 XJ00001 XJ00002 XJ00002 XJ00002 XJ00002...

Users found this page by searching for:

  1. mehrere ordner markieren geht nicht

  1. Diese Seite verwendet Cookies, um Inhalte zu personalisieren, diese deiner Erfahrung anzupassen und dich nach der Registrierung angemeldet zu halten.
    Auf dieser Website werden Cookies für die Zugriffsanalyse und Anzeigenmessung verwendet.
    Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies.
    Information ausblenden