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

Pfad abfragen, Dateien filtern, Liste füllen

Pfad abfragen, Dateien filtern, Liste füllen
05.04.2018 11:53:17
Alexander
Guten Morgen,
ich habe ein Vision und wollte mal hören ob das so gehen könnte wie ich mir das vorstelle. Ich muss eine Liste per Hand anlegen mit Teilen die gefertigt (Werkzeugbau) werden müssen. Meine Idee ist es das zu automatisieren.
Fangen wir vorne an. Die Teile (Dateien) liegen in einem Ordner im Netzwerk, der Pfad müsste abgefragt werden.
Ein Ordner sieht zum Beispiel so aus.

Verzeichnis
Verzeichnis
Verzeichnis
Dateiname626.elt
Nochnedati33.elt
pos1 Leiste.elt
pos2 leiste.elt
pos3 Grundplatte.elt
pos105 Abstreifplatte.elt
pos250 Schnittstempel.elt
Dort müssen jetzt alle Teile (Dateiname) rausgefiltert werden die mit "pos" anfangen.
Dann erhalte ich als Ergenbis in etwas das
  • pos1 Leiste.elt

  • pos2 leiste.elt

  • pos3 Grundplatte.elt

  • pos105 Abstreifplatte.elt

  • pos250 Schnittstempel.elt

  • Alles was Schnittstempel heisst muss aus der Liste noch entfernt werden, das Ergebnis ist dann
  • pos1 Leiste.elt

  • pos2 leiste.elt

  • pos3 Grundplatte.elt

  • pos105 Abstreifplatte.elt

  • Jetzt habe ich eine Excelliste wo diese daten eingetragen werden sollen.
    In Spalte A kommt die die Zahl hinter "pos" und in Spalte D der Name ohne Endung (Beispiel: Grundplatte)
    In Spalte C wird noch je nach Name entweder 1.1730, ST52 oder 1.2379 eingetragen
    Beispiel.
    Name = Grundplatte dann Spalte C "ST52"
    Name = Druckplatte dann Spalte C "1.2379"
    Name = Halteplatte dann Spalte C "1.1730"
    Jetzt werden aber nich alle Zeilen ausgefüllt sondern nur A8-A39 / A47 - A78 / A86 - 117 / A125 - 156
    Das gilt auch für Spalte D. Die Zeilen dazwischen sollen halt übersprungen werden, was in einer Schleife kein Problem sein sollte.
    Ich hoffe ich konnte es einigermaßen verständlich erklären.
    Aus Programmierersicht würde ich sagen das ist machbar, leider kann ich kein VBA. Wie schätzt ihr die Machbarkeit und den Aufwand ein?
    Gruß Alex

    3
    Beiträge zum Forumthread
    Beiträge zu diesem Forumthread

    Betreff
    Datum
    Anwender
    Anzeige
    AW: Pfad abfragen, Dateien filtern, Liste füllen
    05.04.2018 13:23:00
    ChrisL
    Hi Alex
    Technisch machbar ja. Programmieren ohne VBA geht hingegen schlecht.
    Dateisuche z.B.
    https://www.herber.de/forum/messages/1617981.html
    Nummer extrahieren z.B.
    Sub t()
    Dim s As String
    s = "pos105 Abstreifplatte.elt"
    MsgBox Mid(s, 4, InStr(1, s, " ") - 4)
    End Sub
    
    Zeilen überspringen kann man schon, ist aber aus programmiertechnischer Sicht Quatsch. Datenverarbeitung und Visualisierung (Annahme: Grund für Sprung) würde ich von einander trennen.
    cu
    Chris
    Anzeige
    AW: Pfad abfragen, Dateien filtern, Liste füllen
    05.04.2018 16:04:25
    snb
    
    Sub M_snb()
    With Application.FileDialog(4)
    If .Show Then sn = Filter(Split(CreateObject("wscript.shell").exec("cmd /c dir """ & . _
    SelectedItems(1) & "pos*.elt"" /b/s").stdout.readall, vbCrLf), "Stempel", 0)
    End With
    sheets(1).cells(1).resize(ubound(sn)+1)=application.transpose(sn)
    End Sub
    

    ist machbar...
    05.04.2018 14:08:26
    Tino
    Hallo,
    könnte so gehen, aber ohne VBA Kenntnisse schwer nachvollziehbar?!
    kommt als Code in Modul1
    Option Explicit 

    Sub Beispiel()
    Dim strFolder$
    Dim n&, nRow&, lngFileCount&
    Dim ArrayData(), ArrayFile(), ArFileFilter()
    Dim varValues

    strFolder = "G:\1 Forum\" 'Such-Ordner

    ArFileFilter = Array("pos?* *.elt") 'Filter suche
    FindFiles ArrayFile, strFolder, lngFileCount, ArFileFilter, True, False

    If lngFileCount > 0 Then
    Redim ArrayData(1 To lngFileCount, 1 To 4)
    For n = Lbound(ArrayFile) To Ubound(ArrayFile)
    'ohne Schnittstempel
    If InStr(ArrayFile(n), "Schnittstempel") = 0 Then
    nRow = nRow + 1
    varValues = Split(ArrayFile(n), " ")
    'Nummer ohne Pos
    ArrayData(nRow, 1) = Replace(varValues(0), "pos", "")
    'Name ohne .elt
    ArrayData(nRow, 4) = Replace(varValues(Ubound(varValues)), ".elt", "")
    ' Name = Grundplatte Spalte C "ST52"
    ' Name = Druckplatte Spalte C "1.2379"
    ' Name = Halteplatte Spalte C "1.1730"
    Select Case ArrayData(nRow, 4)
    Case "Grundplatte": ArrayData(nRow, 3) = "ST52"
    Case "Druckplatte": ArrayData(nRow, 3) = "1.2379"
    Case "Halteplatte": ArrayData(nRow, 3) = "1.1730"
    End Select
    End If
    Next

    ' Ausgabe
    If nRow > 0 Then
    With Tabelle1 'Ausgabetabelle angeben
    With .Range("A2").Resize(nRow, Ubound(ArrayData, 2))
    .Value = ArrayData
    End With
    End With
    End If
    End If



    End Sub
    kommt als Code in Modul2
    Option Explicit 

    'Teile des Originalcode von Nepumuk. ***********************************************************

    Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" ( _
    ByVal lpFileName As String, _
    lpFindFileData As WIN32_FIND_DATA) As Long
    Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" ( _
    ByVal hFindFile As Long, _
    lpFindFileData As WIN32_FIND_DATA) As Long
    Private Declare Function FindClose Lib "kernel32" ( _
    ByVal hFindFile As Long) As Long

    Private Const INVALID_HANDLE_VALUE = -1&
    Private Const MAX_PATH = 260&

    Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
    End Type

    Private Enum FILE_ATTRIBUTE
    FILE_ATTRIBUTE_READONLY = &H1
    FILE_ATTRIBUTE_HIDDEN = &H2
    FILE_ATTRIBUTE_SYSTEM = &H4
    FILE_ATTRIBUTE_DIRECTORY = &H10
    FILE_ATTRIBUTE_ARCHIVE = &H20
    FILE_ATTRIBUTE_NORMAL = &H80
    FILE_ATTRIBUTE_TEMPORARY = &H100
    End Enum

    Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
    End Type


    Sub FindFiles(ArrayData(), ByVal strFolderPath As String, _
    ByRef lngFileCount As Long, ArFileFilter, Optional SubFolder As Boolean = True, Optional booFullPath As Boolean = True)
    Dim WFD As WIN32_FIND_DATA, lngSearch As Long, strDirName As String

    lngSearch = FindFirstFile(strFolderPath & "*.*", WFD)

    If lngSearch <> INVALID_HANDLE_VALUE Then
    GetFilesInFolder ArrayData, strFolderPath, lngFileCount, ArFileFilter, booFullPath
    Do
    If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
    strDirName = Left$(WFD.cFileName, InStr(WFD.cFileName, Chr(0)) - 1)
    If SubFolder = False Then Exit Sub 'ohne Unterordner
    If (strDirName <> ".") And (strDirName <> "..") Then _
    FindFiles ArrayData, strFolderPath & strDirName & "\", lngFileCount, ArFileFilter, SubFolder, booFullPath
    End If
    Loop While FindNextFile(lngSearch, WFD)
    FindClose lngSearch
    End If
    End Sub

    Sub GetFilesInFolder(ArrayData(), ByVal strFolderPath As String, _
    ByRef lngFileCount As Long, ArFileFilter, Optional booFullPath As Boolean = True)
    Dim WFD As WIN32_FIND_DATA, lngSearch As Long, strFileName As String
    Dim FileFilter

    For Each FileFilter In ArFileFilter
    lngSearch = FindFirstFile(strFolderPath & FileFilter, WFD)
    If lngSearch <> INVALID_HANDLE_VALUE Then
    Do
    If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> _
    FILE_ATTRIBUTE_DIRECTORY Then
    strFileName = Left$(WFD.cFileName, InStr(WFD.cFileName, Chr(0)) - 1)
    Redim Preserve ArrayData(lngFileCount)
    ArrayData(lngFileCount) = _
    IIf(booFullPath, strFolderPath & strFileName, strFileName)
    lngFileCount = lngFileCount + 1
    End If
    Loop While FindNextFile(lngSearch, WFD)
    FindClose lngSearch
    End If
    Next
    End Sub
    Gruß Tino
    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige