VBA : Liste User in einen Ordner

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Lukas,

Sub countFilesPerName()
  Dim strFile As String, strPath As String, varFiles() As Variant, varResult() As Variant
  Dim lngIndex As Long, lngN As Long

  strPath = "D:\Downloads\forum" 'Verzeichnis - Anpassen! 

  If Right(strPath, 1) <> "\" Then strPath = strPath & "\"

  strFile = Dir(strPath & "*_*.xls*", vbNormal)

  Do While Len(strFile)
    Redim Preserve varFiles(lngN)
    varFiles(lngN) = Split(strFile, "_")(0)
    lngN = lngN + 1
    strFile = Dir
  Loop
  If lngN > 0 Then
    Redim Preserve varResult(1 To lngN, 1 To 2)
    lngN = 0
    For lngIndex = 1 To Ubound(varFiles)
      If IsError(Application.VLookup(varFiles(lngIndex), varResult, 1, 0)) Then
        lngN = lngN + 1
        varResult(lngN, 1) = varFiles(lngIndex)
        varResult(lngN, 2) = Application.Count(Application.Match(varFiles, Array(varFiles(lngIndex)), 0))
      End If
    Next
    With Sheets("Tabelle1") 'Ausgabeblatt - Anpassen! 
      .Range("A2:B" & .UsedRange.Rows.Count) = ""
      If lngN > 0 Then .Range("A2").Resize(lngN, 2) = varResult
    End With
  End If
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

	A	B	C	D	E	F
1	Gruß Sepp
2
3

Sub ReadDir() Dim FileName As String Dim FilePfad As String Dim MySplit() As String Dim MyDate As Date Dim cc As Long cc = 1 FilePfad = "C:Lager\Abteilung\Meldungen\" 'Anpassen FileName = Dir(FilePfad & "*.xlsx") Do While FileName <> "" MySplit = Split(FileName, ".") ' .xlsx abtrennen If FileName <> "Meldungen" Then MySplit = Split(MySplit(0), "_") ' Name/Datum trennen Worksheets("Tabelle2").Cells(cc, 1).Value = MySplit(0) ' Name If Len(MySplit(1)) = 8 Then MyDate = DateSerial(Mid(MySplit(1), 5, 4), Mid(MySplit(1), 3, 2), Mid(MySplit(1), 1, 2)) 'Jahr,Monat,Tag Worksheets("Tabelle2").Cells(cc, 2).Value = MyDate ' Datum Worksheets("Tabelle2").Cells(cc, 3).Formula = "=Countifs($A:$A,A" & cc & ")" Else MsgBox "falsches Datumsfomat: " & FileName cc = cc - 1 End If End If FileName = Dir cc = cc + 1 Loop End Sub VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media Code erstellt und getestet in Office 15 - mit VBAHTML 12.6.0

Do While FileName <> "" Worksheets("Tabelle2").Cells(cc, 4).Value = FileName ' nur zum testen MySplit = Split(FileName, ".") ' .xlsx abtrennen VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media Code erstellt und getestet in Office 15 - mit VBAHTML 12.6.0

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA : Liste User in einen Ordner

17 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread