Skapa mappstruktur
FSOHär visas hur vi kan skapa en mappstruktur mha en FSO-baserad funktion.
Glöm inte av att ange referens till Microsoft Scripting Runtime - Läs mer här»
Option Explicit
Option Base 0
Sub SkapaMapp()
'© 2002 Alla rättigheter XL-Dennis
Dim stMapp As String
'Här anges hela sökvägen till den mapp som ska skapas.
stMapp = "f:\XL\XLDennis\FSO\"If Skapa_MappStruktur(stMapp) Then
MsgBox "Mappstrukturen skapad."
End If
End Sub
Public Function Skapa_MappStruktur(stMappSkapa As String) As Boolean
'© 2002 Alla rättigheter XL-Dennis
Dim fsoObj As Scripting.FileSystemObject
Dim stTemp As String, stNivaMappar() As String
Dim lnMappNiva As Long, lnHuvudMappNiva As Long
On Error GoTo Felhantering
Set fsoObj = New Scripting.FileSystemObject
ReDim stNivaMappar(0)
With fsoObj
If Not .FolderExists(stMappSkapa) Then
'Hämtar sökvägen till mappen
stNivaMappar(0) = stMappSkapa
stTemp = .GetParentFolderName(stNivaMappar(0))
'Lägger till mappnivåerna i sökvägen till arrayen
Do While Len(stTemp)
lnMappNiva = lnMappNiva + 1
ReDim Preserve stNivaMappar(lnMappNiva)
stNivaMappar(lnMappNiva) = stTemp
stTemp = .GetParentFolderName(stTemp)
Loop
'Loopa igenom mappstrukturen nedifrån och upp och
'skapa mapparna på de olika nivåerna.
'Högsta nivån utgörs av rooten ( här "f:\") varför den ej ska skapas.
'Detta sker genom att reducera antalet nivåer med -1
For lnHuvudMappNiva = UBound(stNivaMappar) - 1 To 0 Step -1
If Not .FolderExists(stNivaMappar(lnHuvudMappNiva)) Then
.CreateFolder stNivaMappar(lnHuvudMappNiva)
End If
Next lnHuvudMappNiva
'Skapandet av mappstrukturen är klar.
Skapa_MappStruktur = True
Else
MsgBox "Mappen existerar redan."
End If
End With
ExitFunction:
Set fsoObj = Nothing
Exit Function
Felhantering:
Resume ExitFunction
End Function