Vytvoření složky pokud neexistuje Vyřešeno

[Jsimi]

Ahoj,
pomocí tohoto makra ukládám sešit na předem definované místo.
týden = Range("G1")
rok = Range("N1")
cesta = "G:\GROUPS\Departments\Provoz Steti\BP-Balici papiry\Veřejné\MGRB\Check List\" & rok & "\" & týden & ""Lze nějak definovat, aby, pokud zložka s rokem nebo týdnem, do které má dojít k uložení byla automaticky vytvořena pokud ještě neexistuje?

Předem dík za radu.

[Reklama]

[d1amond]

Ano, lze.
http://www.ozgrid.com/forum/showthread.php?t=32259
Poslední příspěvek je celkem slušně sepsaný. Kdyby něco nebylo jasné, poradíme dál.

[Jsimi]

Tak z toho jsem mimo. V makrech se vyznám jen minimálně, zatím se učím základy, co znám mám odsud a s AJ to je taky bída.

[d1amond]

Tak sem dej xls s tím co už máš.

[Jsimi]

Jsou tam tři tlačítka "potvrdit PS", "Potvrdit převíječka" a " převzít od PS". Všechny tři jsou podobné a hlavní úkol je uložit Check list do složky se správným rokem, týdnem a pod správným číslem. Stačí se tedy zabývat pouze jedním.

[d1amond]

Trošku jsem to poupravil a nyní je přímo fcí ošetřeno vytvoření složek. Pokud fce projde, lze ukládat soubor, jinak končí chybovou hláškou errMsg.

Kód: Vybrat vše

Sub UlozChckList()
Const defPath As String = "E:\Temp\" 'cesta do složky s rokem
Dim errMsg As String

errMsg = ""

'fce na kontrolu existence adresare
If DirExists(defPath) = False Then
    errMsg = errMsg & "Nepodařilo se vytvořit složku!"
    GoTo TheEnd
End If


'zde vlozit kod s ukladanim souboru



TheEnd:
    If errMsg <> "" Then
        MsgBox errMsg, vbCritical
        Exit Sub
    End If
End Sub
 
Public Function DirExists(defPath As String) As Boolean

Dim path As String
Dim tyden As String
Dim rok As String

DirExists = 0

tyden = Worksheets("List1").Range("A1").Value
rok = Worksheets("List1").Range("A2").Value

'kontrola na adresar ROK
If Dir(defPath & rok, vbDirectory) = "" Then
    MkDir defPath & rok
End If

'kontrola na adresar tyden
If Dir(defPath & rok & "\" & tyden, vbDirectory) = "" Then
    MkDir defPath & rok & "\" & tyden
End If

path = defPath & rok & "\" & tyden

If Dir(path, vbDirectory) = "" Then
    DirExists = False
Else: DirExists = True
End If

End Function


Proceduru UlozChckList() a fci DirExists(defPath) vlož kam potřebuješ - do modulů? Pak si jen do té procedury doplň část kódu s ukládáním souboru.
Zároveň si změň defPath na svou cestu a ve fci změň List1 na svůj a buňky A1 a A2 na Tvé s týdnem a rokem.

[Jsimi]

Moc děkuji za pomoc.Chodí perfektně jak jsem si představoval.
Chvála tomuto foru.
Ahoj