PDA

Vollständige Version anzeigen : Ordnerstruktur und Dateien


Sammy117
07.09.2011, 22:13
Hallo Leute meine Name is Sascha und ich komme aus Österreich,
hoffe ihr könnt mir helfen, bin eher noch eine blutiger Anfänger in VAB. ;)

Also zu meinem Problem ich brauch einen Code für eine gescheite Ordnerstruktur mit Unterordner und den darin befindlichen Dateien.
Was sehr wichtig wäre ist das sich wenn ich die excel schließe und währendessen neue Ordner oder Dateien erstelle , die beim neuen öffnen automatisch/ oder mit Button akualisiert wird.
Dann wäre vielleicht auch noch cool wenn Erstelldatum dabei steht und die Dateien einen Hyperlink besitzen.

Ich hab auch vieles gesucht aber genau was ich will find ich nirgends.
Hoffentlich ist das nicht zu viel verlangt

Mfg,

Sascha

AKTools
08.09.2011, 08:58
Hi Sammy,

hier mal ein erster Code. Probier mal aus ob das ungefährt das ist was du brauchst. Bitte den Ordner (rot) noch anpassen!!!

Option Explicit

Dim FSO As Scripting.FileSystemObject
Dim Counter As Long

Sub OrdnerEinlesen()
Application.ScreenUpdating = False
Counter = 1
Call Ordnerstruktur("C:\Program Files")
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub

Function Ordnerstruktur(sParentFolderPath As String)
On Error Resume Next
Set FSO = GetObject(, "Scripting.FileSystemObject")
On Error GoTo 0
If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")

Dim Ordner As Folder
Dim Datei As File
Dim oParentFolder As Folder
Set oParentFolder = FSO.GetFolder(sParentFolderPath)
Dim OrdnerPlitting As Variant
Dim x As Long
Dim A As Variant

If oParentFolder.SubFolders.Count > 0 Then
For Each Ordner In oParentFolder.SubFolders
OrdnerPlitting = Split(Ordner.Path, "\")
For x = LBound(OrdnerPlitting) To UBound(OrdnerPlitting)
With ActiveSheet
.Cells(Counter, 1).Value = FormatDateTime(Ordner.DateCreated, vbShortDate)
.Cells(Counter, x + 2).Value = OrdnerPlitting(x)
.Hyperlinks.Add Anchor:=.Cells(Counter, x + 2), Address:= _
Ordner.Path & "\", SubAddress:=Ordner.Path, TextToDisplay:=Ordner.Name
End With
Next x

Application.StatusBar = Counter
'***Datum hinter rechts neben der Ordnerstruktur
'Cells(Counter, UBound(OrdnerPlitting) + 2).Value = FormatDateTime(Ordner.DateCreated, vbShortDate)

Counter = Counter + 1
If Ordner.SubFolders.Count > 0 Then Call Ordnerstruktur(Ordner.Path)
Next Ordner
End If

Set oParentFolder = Nothing
Set FSO = Nothing
End Function

Sammy117
08.09.2011, 19:23
Sehr nett danke für die schnelle Antwort aber irgendwie haut er mir bei deinem Code einen Order gleich 5 mal hintereinander in eine zeile ?

Habe hier noch schnell per hand ein kleines Beispiel gemacht damit düfte es leichter verständlich sein vielleicht funzt das so irgendwie.

Hajo_Zi
08.09.2011, 19:49
Hallo Sammy,

Ordner auslesen (http://hajo-excel.de/chCounter3/getfile.php?id=21)

<img src="http://Hajo-Excel.de/images/grusz1.gif" align="middle" height="40" alt="Grußformel"><a href="http://Hajo-Excel.de/index.htm" onclick="window.open(this.href);return false"><img border="0" src="http://Hajo-Excel.de/images/logo_hajo3.gif" align="middle" height="40" alt="Homepage"></a>

Sammy117
08.09.2011, 20:48
Hallo Hajo,

erstmal vielen Dank für die schnelle Antwort
Dein Code is sehr gut und beinhaltet eigentlich fast alles was ich brauch , aber
was mir eigentlich am wichtigsten ist ist die Ordnerstruktur also die Oberordner und Unter Ordner so versetzt wie in meinem Beispiel.
Die Ordner sind halt sehr wichtig für mich.
Ich weiß ich bin sehr umständlich aber bitte habt Geduld mit mir ;)


Mfg,

Sascha

Hajo_Zi
08.09.2011, 21:33
Hallo Sascha,

Das ist mir jetzt zu aufwendig. Ich bin nicht mehr lange an meinem Homerechner.

<a href="http://Hajo-Excel.de/index.htm" target="_blank" title="Hajo's Excelseiten">Gruß Hajo</a>

josef e
08.09.2011, 22:05
<div style="width:85%; margin-left:5px; margin-right:15px; text-align:justify;">
Hallo Sascha,

probier mal.


</div>

<div style="width:100px; text-align:center; color:white; font-style:italic; font-size:0.8em; font-family:Tahoma; background-color:royalblue;margin-left:5px; margin-top:15px; padding:4px; border:3px double darkblue;">&laquo; Gru&szlig; Sepp &raquo;</div>

Sammy117
08.09.2011, 22:43
Wow super wahnsinn genau was ich gesucht habe :)

Großen Dank an alle die mir geholfen haben.

Mfg,

Sascha

Sammy117
12.09.2011, 12:17
Hallo Leute,

habe noch eine Frage , wenn ich mit dem letzten Programm auf ein geschützes Laufwerk zugreif krieg ich den Fehler 52 kann ich da igrendwas machen außer dem Administrator sagen er soll mir Rechte geben?

Mfg,

Sascha

Sammy117
12.09.2011, 18:59
Push up

josef e
12.09.2011, 20:42
<div style="width:85%; margin-left:5px; margin-right:15px; text-align:justify;">
Hallo Sascha,

ungeduldig?

Im Prinzip ja, probiere mal, ob sich so der Fehler abfangen lässt.

<div style="background-color:#F5F5F5; border-width:2px; border-style: groove; border-color:#ff9966; padding:4px;"><nobr><span style="font-family:Courier New,Arial; font-size:8pt ;" ><span style="color:#008000"; >' **********************************************************************</span><br /><span style="color:#008000"; >' Modul: Modul1 Typ: Allgemeines Modul</span><br /><span style="color:#008000"; >' **********************************************************************</span><br /><br /><span style="color:#00009B"; >Option</span> <span style="color:#00009B"; >Explicit</span><br /><br /><span style="color:#00009B"; >Dim</span> FSO, FO, FU, F<br /><span style="color:#00009B"; >Dim</span> lngRow <span style="color:#00009B"; >As</span> <span style="color:#00009B"; >Long</span><br /><span style="color:#00009B"; >Dim</span> lngCol <span style="color:#00009B"; >As</span> <span style="color:#00009B"; >Long</span><br /><br /><br /><b><span style="color:#00009B"; >Sub</span> OrdnerAuflisten()</b><br />&nbsp;&nbsp;<br />&nbsp;&nbsp;<span style="color:#00009B"; >On</span> <span style="color:#00009B"; >Error</span> <span style="color:#00009B"; >GoTo</span> ErrExit<br />&nbsp;&nbsp;tranquilize<br />&nbsp;&nbsp;<br />&nbsp;&nbsp;<span style="color:#00009B"; >Set</span> FSO = CreateObject(<span style="color:#800000"; >"Scripting.FileSystemObject"</span>)<br />&nbsp;&nbsp;<br />&nbsp;&nbsp;lngCol = 0<br />&nbsp;&nbsp;lngRow = 2<br />&nbsp;&nbsp;<br />&nbsp;&nbsp;<span style="color:#00009B"; >With</span> ActiveSheet<br />&nbsp;&nbsp;&nbsp;&nbsp;.UsedRange.Offset(2, 0).Clear<br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#00009B"; >If</span> Dir(.Range(<span style="color:#800000"; >"A2"</span>).Text, vbDirectory) &lt;&gt; "" <span style="color:#00009B"; >Then</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;GetSubFolders .Range(<span style="color:#800000"; >"A2"</span>).Text<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#00009B"; >With</span> .UsedRange.Offset(2, 0).Resize(.UsedRange.Rows.Count - 3, .UsedRange.Columns.Count)<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.HorizontalAlignment = xlLeft<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Borders(xlEdgeLeft).LineStyle = xlContinuous<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Borders(xlEdgeTop).LineStyle = xlContinuous<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Borders(xlEdgeBottom).LineStyle = xlContinuous<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Borders(xlEdgeRight).LineStyle = xlContinuous<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Borders(xlInsideVertical).LineStyle = xlContinuous<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Borders(xlInsideHorizontal).LineStyle = xlContinuous<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#00009B"; >End</span> <span style="color:#00009B"; >With</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Columns.AutoFit<br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#00009B"; >Else</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;MsgBox <span style="color:#800000"; >"Pfad nicht gefunden!"</span><br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#00009B"; >End</span> <span style="color:#00009B"; >If</span><br />&nbsp;&nbsp;<span style="color:#00009B"; >End</span> <span style="color:#00009B"; >With</span><br />&nbsp;&nbsp;<br />&nbsp;&nbsp;ErrExit:<br />&nbsp;&nbsp;<span style="color:#00009B"; >If</span> Err.Number = 52 <span style="color:#00009B"; >Then</span><br />&nbsp;&nbsp;&nbsp;&nbsp;Err.Clear<br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#00009B"; >Resume</span> <span style="color:#00009B"; >Next</span><br />&nbsp;&nbsp;<span style="color:#00009B"; >End</span> <span style="color:#00009B"; >If</span><br />&nbsp;&nbsp;tranquilize <span style="color:#00009B"; >True</span><br /><b><span style="color:#00009B"; >End</span> <span style="color:#00009B"; >Sub</span></b><br /><br /><br /><b><span style="color:#00009B"; >Private</span> <span style="color:#00009B"; >Sub</span> GetSubFolders(<span style="color:#00009B"; >ByVal</span> Path)</b><br />&nbsp;&nbsp;<br />&nbsp;&nbsp;<span style="color:#00009B"; >Set</span> FO = FSO.GetFolder(Path)<br />&nbsp;&nbsp;<span style="color:#00009B"; >Set</span> FU = FO.SubFolders<br />&nbsp;&nbsp;<br />&nbsp;&nbsp;<span style="color:#00009B"; >On</span> <span style="color:#00009B"; >Error</span> <span style="color:#00009B"; >Resume</span> <span style="color:#00009B"; >Next</span><br />&nbsp;&nbsp;<br />&nbsp;&nbsp;<span style="color:#00009B"; >For</span> Each F In FU<br />&nbsp;&nbsp;&nbsp;&nbsp;<br />&nbsp;&nbsp;&nbsp;&nbsp;lngRow = lngRow + 1<br />&nbsp;&nbsp;&nbsp;&nbsp;lngCol = lngCol + 1<br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#00009B"; >With</span> ActiveSheet<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Hyperlinks.Add Anchor:=.Cells(lngRow, lngCol), Address:=F.Path, TextToDisplay:=F.Name<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#00009B"; >With</span> .Cells(lngRow, lngCol).Font<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.ColorIndex = 3<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Underline = <span style="color:#00009B"; >False</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#00009B"; >End</span> <span style="color:#00009B"; >With</span><br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#00009B"; >End</span> <span style="color:#00009B"; >With</span><br />&nbsp;&nbsp;&nbsp;&nbsp;GetFiles F.Path<br />&nbsp;&nbsp;&nbsp;&nbsp;GetSubFolders F.Path<br />&nbsp;&nbsp;&nbsp;&nbsp;<br />&nbsp;&nbsp;<span style="color:#00009B"; >Next</span><br />&nbsp;&nbsp;<br />&nbsp;&nbsp;lngCol = lngCol - 1<br />&nbsp;&nbsp;<br /><b><span style="color:#00009B"; >End</span> <span style="color:#00009B"; >Sub</span></b><br /><br /><br /><b><span style="color:#00009B"; >Private</span> <span style="color:#00009B"; >Sub</span> GetFiles(<span style="color:#00009B"; >ByVal</span> Path)</b><br />&nbsp;&nbsp;<span style="color:#00009B"; >Dim</span> strFile <span style="color:#00009B"; >As</span> <span style="color:#00009B"; >String</span><br />&nbsp;&nbsp;<br />&nbsp;&nbsp;<span style="color:#00009B"; >On</span> <span style="color:#00009B"; >Error</span> <span style="color:#00009B"; >Resume</span> <span style="color:#00009B"; >Next</span><br />&nbsp;&nbsp;<br />&nbsp;&nbsp;strFile = Dir(Path & <span style="color:#800000"; >"\*"</span>, vbNormal)<br />&nbsp;&nbsp;<span style="color:#00009B"; >Do</span> <span style="color:#00009B"; >While</span> strFile &lt;&gt; ""<br />&nbsp;&nbsp;&nbsp;&nbsp;lngRow = lngRow + 1<br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#00009B"; >With</span> ActiveSheet<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Hyperlinks.Add _<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Anchor:=.Cells(lngRow, lngCol), _<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Address:=Path & <span style="color:#800000"; >"\"</span> & strFile, _<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;TextToDisplay:=strFile & <span style="color:#800000"; >" ("</span> & Format(FileDateTime(Path & <span style="color:#800000"; >"\"</span> & strFile), <span style="color:#800000"; >"dd.MM.yyyy"</span>) & <span style="color:#800000"; >")"</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#00009B"; >With</span> .Cells(lngRow, lngCol).Font<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.ColorIndex = 5<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Underline = <span style="color:#00009B"; >False</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#00009B"; >End</span> <span style="color:#00009B"; >With</span><br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#00009B"; >End</span> <span style="color:#00009B"; >With</span><br />&nbsp;&nbsp;&nbsp;&nbsp;strFile = Dir<br />&nbsp;&nbsp;<span style="color:#00009B"; >Loop</span><br />&nbsp;&nbsp;<br /><b><span style="color:#00009B"; >End</span> <span style="color:#00009B"; >Sub</span></b><br /><br /><br /><br /><b><span style="color:#00009B"; >Public</span> <span style="color:#00009B"; >Sub</span> tranquilize(<span style="color:#00009B"; >Optional</span> <span style="color:#00009B"; >ByVal</span> Modus <span style="color:#00009B"; >As</span> <span style="color:#00009B"; >Boolean</span> = <span style="color:#00009B"; >False</span>)</b><br />&nbsp;&nbsp;<span style="color:#00009B"; >Static</span> lngCalc <span style="color:#00009B"; >As</span> <span style="color:#00009B"; >Long</span><br />&nbsp;&nbsp;<br />&nbsp;&nbsp;<span style="color:#00009B"; >With</span> Application<br />&nbsp;&nbsp;&nbsp;&nbsp;.ScreenUpdating = Modus<br />&nbsp;&nbsp;&nbsp;&nbsp;.EnableEvents = Modus<br />&nbsp;&nbsp;&nbsp;&nbsp;.DisplayAlerts = Modus<br />&nbsp;&nbsp;&nbsp;&nbsp;.EnableCancelKey = IIf(Modus, 1, 0)<br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#00009B"; >If</span> <span style="color:#00009B"; >Not</span> Modus <span style="color:#00009B"; >Then</span> lngCalc = .Calculation<br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#00009B"; >If</span> Modus <span style="color:#00009B"; >And</span> lngCalc = 0 <span style="color:#00009B"; >Then</span> lngCalc = -4105<br />&nbsp;&nbsp;&nbsp;&nbsp;.Calculation = IIf(Modus, lngCalc, -4135)<br />&nbsp;&nbsp;&nbsp;&nbsp;.Cursor = IIf(Modus, -4143, 2)<br />&nbsp;&nbsp;<span style="color:#00009B"; >End</span> <span style="color:#00009B"; >With</span><br />&nbsp;&nbsp;<br />&nbsp;&nbsp;<span style="color:#00009B"; >If</span> Modus <span style="color:#00009B"; >Then</span><br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#00009B"; >With</span> Err<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#00009B"; >If</span> .Number &lt;&gt; 0 <span style="color:#00009B"; >Then</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;MsgBox IIf(Erl, vbLf & <span style="color:#800000"; >"Fehler in Zeile:"</span> & vbTab & Erl & vbLf & vbLf, "") & _<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#800000"; >"Fehlernummer:"</span> & vbTab & .Number & vbLf & vbLf & <span style="color:#800000"; >"Beschreibung:"</span> & vbLf & _<br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Description, vbExclamation, <span style="color:#800000"; >"Fehler"</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#00009B"; >End</span> <span style="color:#00009B"; >If</span><br />&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;.Clear<br />&nbsp;&nbsp;&nbsp;&nbsp;<span style="color:#00009B"; >End</span> <span style="color:#00009B"; >With</span><br />&nbsp;&nbsp;<span style="color:#00009B"; >End</span> <span style="color:#00009B"; >If</span><br /><b><span style="color:#00009B"; >End</span> <span style="color:#00009B"; >Sub</span></b><br /><br /></span></nobr></div>


</div>

<div style="width:100px; text-align:center; color:white; font-style:italic; font-size:0.8em; font-family:Tahoma; background-color:royalblue;margin-left:5px; margin-top:15px; padding:4px; border:3px double darkblue;">&laquo; Gru&szlig; Sepp &raquo;</div>

Sammy117
12.09.2011, 21:02
Nein gar net , naja vielleicht ein bissi :p

Super danke dann kann ich es gleich morgen früh ausprobieren.

Nochmals vielen Dank sag morgen gleich bescheid wies gelaufen is ^^

Mfg,

Sascha