Stránka 1 z 1
Vytvoření složky pokud neexistuje
Napsal: 30 pro 2012 08:35
od 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.
Re: Vytvoření složky pokud neexistuje
Napsal: 30 pro 2012 09:13
od d1amond
Ano, lze.
http://www.ozgrid.com/forum/showthread.php?t=32259Poslední příspěvek je celkem slušně sepsaný. Kdyby něco nebylo jasné, poradíme dál.
Re: Vytvoření složky pokud neexistuje
Napsal: 30 pro 2012 09:23
od 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.
Re: Vytvoření složky pokud neexistuje
Napsal: 30 pro 2012 09:32
od d1amond
Tak sem dej xls s tím co už máš.
Re: Vytvoření složky pokud neexistuje
Napsal: 30 pro 2012 09:46
od 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.
Re: Vytvoření složky pokud neexistuje
Napsal: 30 pro 2012 11:51
od 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.
Re: Vytvoření složky pokud neexistuje Vyřešeno
Napsal: 30 pro 2012 12:25
od Jsimi
Moc děkuji za pomoc.Chodí perfektně jak jsem si představoval.
Chvála tomuto foru.
Ahoj