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

Programy pro práci v kanceláři (Word, Excel, Access…=>Office)

Moderátor: Mods_senior

Transmit
nováček
Příspěvky: 29
Registrován: leden 10
Pohlaví: Muž
Stav:
Offline

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

Příspěvekod Transmit » 24 úno 2017 14:55

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!
Přílohy
Sešit1.xlsx
(8.05 KiB) Staženo 52 x

Reklama
guest
Pohlaví: Nespecifikováno

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

Příspěvekod guest » 24 úno 2017 16:22

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
nováček
Příspěvky: 29
Registrován: leden 10
Pohlaví: Muž
Stav:
Offline

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

Příspěvekod Transmit » 24 úno 2017 17:02

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

birgis
nováček
Příspěvky: 36
Registrován: březen 11
Pohlaví: Muž
Stav:
Offline

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

Příspěvekod birgis » 28 úno 2017 08:11

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


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Ruční vytvoření spouštěcího oddílu na SSD
    od Haalf » 23 pro 2024 11:08 » v Windows 11, 10, 8...
    8
    3602
    od pcmaker Zobrazit poslední příspěvek
    23 pro 2024 17:26
  • Obsah složky se zrcadlí na ploše Příloha(y)
    od Grander » 01 dub 2025 17:44 » v Windows 11, 10, 8...
    4
    2718
    od Grander Zobrazit poslední příspěvek
    02 dub 2025 15:29

Zpět na “Kancelářské balíky”

Kdo je online

Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 3 hosti