Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1612to1616
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

Daten aus Excel in Dateinordner suchen und ablegen

Daten aus Excel in Dateinordner suchen und ablegen
07.03.2018 13:21:27
Rene
Hallo zusammen,
ich bin Anfänger was VBA angeht und habe gleich eine große Aufgabe vor mir.
Es geht darum Daten aus einer Excel Liste (6stellige Zahlen, Spalte frei wählbar)auf dem Laufwerk zu suchen. Ablageort auf dem Laufwerk ist immer fix (Ordner + Unterordner). Gesucht werden soll nach pdf und dxf bzw. dwg Datensätze. Zu den 6 stelligen Datensätzen gibt es noch Indizies die mit A beginnen und bei Z aufhören. Bsp 812575A
Die Daten sollen dann in einen separaten Ordner kopiert werden.
Kurz gesagt ich möchte für unseren Einkauf Datenpakete schnüren, die sich auf unsere Stücklisten beziehen. Aktuell werden alle Daten händisch gesucht und zusammengestellt. Sehr zeitaufwändig bei vielen Bauteilen.
Vielleicht hat jemand einen Ansatz wie ich da Stück für Stück weiterkomme?
Vielen Dank im Voraus
Gruß
René

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Daten aus Excel in Dateinordner suchen und ablegen
07.03.2018 14:51:42
UweD
Hallo
meinst du das so?
Beispiel:
  • In Spalte C stehen 6stellige Zahlen untereinander

  • im Verzeichnis x:\Temp stehen Dateien, 6Stellige Zahl plus A -Z plus Endung entweder .pdf, .dxf, .dwg
    123456A.pdf 123456D.dwg...

  • die Dateien, die in den ersten 6 Stellen übereinstimmen und die richtige Endung haben

  • sollen alle in das Zielverzeichnis kopiert werden...,

  • Dann so...
    Sub Dateien_kopieren()
        On Error GoTo Fehler
        Dim TB, L1 As Integer, LR As Double, Z
        Dim PfadOld As String, Datei As String
        Dim PfadNew As String, Spalte As String, SP As Integer
        
        Set TB = ActiveWorkbook.Sheets("Tabelle1")
        L1 = 1 'Start ab Zeile1 
        PfadOld = "X:\Temp\" ' inkl. \ am Ende 
        
        PfadNew = "X:\Temp\ABC\" ' inkl. \ am Ende 
        If Dir(PfadNew, vbDirectory) = "" Then MkDir PfadNew ' Wenn Verzeichnis fehlt, erstellen 
        
        Spalte = InputBox("Welche Spalte soll abgearbeitet werden?", "Dateien separieren", "C")
        SP = TB.Columns(Spalte).Column 'Zahl der Spalte 
        LR = TB.Cells(TB.Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte 
            
        For Each Z In TB.Range(TB.Cells(L1, SP), TB.Cells(LR, SP)) 'Jeder Eintag wird abgearbeitet 
            If Z <> "" Then
                Datei = Dir(PfadOld & Z & "*.*")
                Do While Len(Datei) > 0
                
                    Select Case Right(Datei, 4)
                        Case ".pdf", ".dxf", ".dwg"
                            
                            FileCopy PfadOld & Datei, PfadNew & Datei
                            
                        Case Else
                            
                            'nichts 
                            
                    End Select
                    
                    Datei = Dir() ' nächste Datei 
                Loop
            End If
            
        Next
        
        Err.Clear
    Fehler:
        If Err.Number <> 0 Then MsgBox "Fehler: " & _
            Err.Number & vbLf & Err.Description: Err.Clear
    End Sub
    

    LG UweD
    Anzeige

    313 Forumthreads zu ähnlichen Themen

    Anzeige
    Anzeige
    Anzeige

    Links zu Excel-Dialogen

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige