VBA - vytvoření složky v PC dle hodnot v buňkách

[Transmit]

Dobrý den,

poradil by někdo, prosím, jak vytvořit skrz VBA složku v PC podle hodnot v buňkách?
Přikládám soubor s hodnotami v buňkách A1 a A2 jako příklad.
Složka by měla být vytvořena v adresáři

C:\Pojistné události\Scan dokumentů

s tím ale, že cíl je vytvořit nejprve složku dle kalendářního roku (v přiloženém souboru hodnota v buňce A1), pokud již neexistuje, a v ní až pak další podsložku (hodnota v buňce A2). Pokud by existovaly již obě složky, tak by mohlo makro vyhodit hlášku, že "Složka je již vytvořena".

Celá cesta ke složce by tak vypadala C:\Pojistné události\Scan dokumentů\2016\3SH5458_45898569

Hodnoty pro vytvoření složek budou vždy v prvním řádku tabulky v hodnotách A1 a A2, na listu "PU_slozka".
Makro bych spouštěl tlačítkem.

Předem děkuji za radu!

[guest]

Tak když stačí jen rada

Existence souboru/složky se řeší přes Dir, resp. FileExists, FolderExists. Vytváření složky pak má na starosti kupříkladu MkDir.

[Transmit]

:) napsal jsem to špatně, rada nestačí, poprosím celý VBA kod, díky!

[birgis]

Ahoj, mam na to funkci, která kontroluje existenci, případně vytvoří složku

Kód: Vybrat vše

Function myFolderCheck(ByVal myFullPath As String) As Boolean
Dim myPath() As String, i, j, TestPath As String
Dim FSO As Object
myFolderCheck = False
posledni_znak:
If Right(myFullPath, 1) = "\" Then
    myFullPath = Left(myFullPath, Len(myFullPath) - 1)
    GoTo posledni_znak
    End If
myPath() = Split(myFullPath, "\")

For i = LBound(myPath) To UBound(myPath)
    For j = 0 To i
        TestPath = TestPath & myPath(j) & "\"
    Next j
Set FSO = CreateObject("scripting.filesystemobject")
    If FSO.FolderExists(TestPath) = False Then
        MkDir TestPath
End If
    TestPath = Empty
Next i
myFolderCheck = True
End Function