Thema Datum  Von Nutzer Rating
Antwort
05.01.2017 15:36:49 Officer_Bierschnitt
NotSolved
05.01.2017 16:08:00 Holger
Solved
05.01.2017 18:59:50 Günther
NotSolved
Blau Alle Dateien in einem Verzeichnis durchgehen
 08.01.2017 16:38:49 Nobody
NotSolved
09.01.2017 10:23:51 Officer_Bierschnitt
NotSolved
09.01.2017 11:05:57 Günther
NotSolved
09.01.2017 11:15:55 Officer_Bierschnitt
NotSolved

Ansicht des Beitrags:
Von:
Nobody		 Datum:
08.01.2017 16:38:49		 Views:
780		 Rating:
     
Antwort:
  Ja
Thema:
Alle Dateien in einem Verzeichnis durchgehen

Hallo

anbei ein doppelter Code zum auflisten eines ganzen Ordners.  Das 1. Makro erwartet in Zelle C1 den Pfad+Ordnername, in F1 kann man den Dateityp angeben.

Das 2. Makro öffnet einen Auswahl Dialog, wo man die Datei frei waehlen kann.  Leider kann man hier keine Beispieldatei hochladen.  Tabelle selbst einrichten.

mfg  Nobody

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
Option Explicit     'myDir Makro aus dem Internet
'überarbeitete Version von Nobody   27.12.2016
Dim sPfad As String, temp As String
 
 
'1. Makro listet aus Zelle C1 auf
'listet Ordner -ohne- UnterOrdner
 
Sub myDir_auflisten()
Dim Opt As Variant, n As Integer
Dim Dtyp As String, z As Integer
   On Error GoTo Fehler
   Range("C2:C4") = Empty
   Range("A5:E1000").Clear
   Dtyp = Range("F2").Value
   If Dtyp = "" Then Dtyp = "*.*"
   sPfad = Range("C1").Value
   temp = Dir(sPfad & "\" & Dtyp)
    
   If InStr(Dtyp, ".") = 0 Then MsgBox _
      "Ungültiger Dateitup, Punkt fehlt": Exit Sub
 
   'einen Ordner auflisten
   Do While temp <> ""
      z = z + 1:  n = n + 1
      Cells(z + 4, 2) = z
      Cells(z + 4, 3) = temp
      Cells(z + 4, 4) = FileLen(sPfad & "\" & temp)
      Cells(z + 4, 5) = FileDateTime(sPfad & "\" & temp)
      temp = Dir
   Loop
 
   If n > 0 Then Range("A5") = " " & n & " Dateien"
   If n = Empty Then [c2] = "Ordner No Find / Leer, oder Dateityp ungültig"
    
   Range("A2").Value = Now
   Range("B5", [b5].End(xlDown)).HorizontalAlignment = xlCenter
Exit Sub
 
Fehler: MsgBox "unerwarteter Fehler - Abbruch"
End Sub
 
 
'2. Makro:  Ordner Auswahl über Dialogfeld
 
Sub myDir_Auswäahlen()
Dim Opt As Variant, n As Integer
Dim Dtyp As String, z As Integer
   'Ordner Auswahl über Dialogfeld
   With Application.FileDialog(msoFileDialogFolderPicker)
     .AllowMultiSelect = False
      If .Show = 0 Then Exit Sub
      sPfad = .SelectedItems(1)
   End With
 
   On Error GoTo Fehler
   Range("C2:C4") = Empty
   Range("A5:E1000").Clear
   Range("C3") = sPfad
   Dtyp = Range("F2").Value
   If Dtyp = "" Then Dtyp = "*.*"
   temp = Dir(sPfad & "\" & Dtyp)
    
   If InStr(Dtyp, ".") = 0 Then MsgBox _
      "Ungültiger Dateitup, Punkt fehlt": Exit Sub
 
   'einen Ordner auflisten
   Do While temp <> ""
      z = z + 1:  n = n + 1
      Cells(z + 4, 2) = z
      Cells(z + 4, 3) = temp
      Cells(z + 4, 4) = FileLen(sPfad & "\" & temp)
      Cells(z + 4, 5) = FileDateTime(sPfad & "\" & temp)
      temp = Dir
   Loop
 
   If n > 0 Then Range("A5") = " " & n & " Dateien"
   If n = Empty Then [c2] = "Ordner No Find / Leer, oder Dateityp ungültig"
    
   Range("A2").Value = Now
   Range("B5", [b5].End(xlDown)).HorizontalAlignment = xlCenter
Exit Sub
 
Fehler: MsgBox "unerwarteter Fehler - Abbruch"
End Sub

 

 

.

 

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:
WYSIWYG-Editor, ctl00_Content_editor1



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
05.01.2017 15:36:49 Officer_Bierschnitt
NotSolved
05.01.2017 16:08:00 Holger
Solved
05.01.2017 18:59:50 Günther
NotSolved
Blau Alle Dateien in einem Verzeichnis durchgehen
 08.01.2017 16:38:49 Nobody
NotSolved
09.01.2017 10:23:51 Officer_Bierschnitt
NotSolved
09.01.2017 11:05:57 Günther
NotSolved
09.01.2017 11:15:55 Officer_Bierschnitt
NotSolved