23. september 2014 - 19:18
Der er
5 kommentarer og
2 løsninger
Finde folder i under folder
Hej
Hvem kan hjælpe med dette problem,(for mig)
Jeg har et bibliotek med mange foldere, der igen indeholder mange foldere som igen indeholder foldere.
Jeg vil gerne kunne lave en VBA code der finder en bestemt folder i denne struktur.
For eksempel findes denne folder H:\top\test2\test3\test3\dennefolder
hvor jeg starter søgningen i folderen 'top' og skal finde 'dennefolder'.
Det drejer sig om jeg skal søge igennem alle foldere i H:\top og når den finder den ønskede folder skal den vis stien til folderen.
Jeg kan lave koden så den søger igennem H:\top men kan ikke finde ud af at komme igennem alle folderen.
/fajens
23. september 2014 - 23:24
#2
Hvis du blot skal afgøre om "H:\top\test2\test3\test3\dennefolder" eksisterer, er det givet ved udtrykket:
Len(Dir("H:\top\test2\test3\test3\dennefolder", vbDirectory)) > 0
Men ellers ...
Måden at arbejde sig gennem en mappestruktur vha dir(), er en mappe af gangen - det er nødvendigt pga dir() virkemåde med at finde næste indtil der ikke er flere i mappen.
Følgende funktion: tree(...) returnere mappenavne som et array af strings.
Den skal kaldes med backslash afsluttet mappenavn - f.eks
mapper = tree("h:\top\")
Det besvarer ikke dit spørgsmål - hvordan findes en mappe med et bestemt navn - men er til inspiration om hvordan man kan grave sig gennem undermapper.
Function tree(dirNameSlash)
Dim dirName, subDir, treeCopy
dirName = dirN(dirNameSlash, True)
While Len(dirName)
addS2list tree, dirNameSlash & dirName
dirName = dirN(dirNameSlash): Wend
If Not IsEmpty(tree) Then
treeCopy = tree
For Each dirName In treeCopy
subDir = tree(dirName & "\")
If Not IsEmpty(subDir) Then addS2list tree, subDir
Next: End If
End Function
'Hjælpefunktioner:
Function dirN(containedInS, Optional isFirst = False)
If isFirst Then
dirN = Dir(containedInS, vbDirectory)
Else
dirN = Dir(): End If
While (Len(dirN) > 0) And (((GetAttr(containedInS & dirN) And vbDirectory) = 0) Or dirN = "." Or dirN = "..")
dirN = Dir()
Wend
End Function
Sub addS2list(V, i)
Dim ai
On Error Resume Next
If IsArray(i) Then
For Each ai In i
addS2list V, ai: Next
Else
ReDim Preserve V(UBound(V) + 1)
If err.Number = 13 Then ReDim V(0)
If IsObject(i) Then Set V(UBound(V)) = i Else V(UBound(V)) = i
End If
End Sub
25. september 2014 - 08:47
#4
Hej terry
Tak for dit link, det er noget jeg kan bruge, det virker efter lidt ændringer til mit brug.
Smid et svar så du kan få point.
