Použiť môžete nejakú univerzálnejšiu metódu, kde je jedno koľko vnorení budete požadovať. Napr. :
Sub Ulozit()
Dim strCesta As String, strJmeno As String, strFolder As String
With wksUvod
strFolder = .Range("D1").Value & "\" & Year(.Range("B3").Value) & "\" & .Range("B2").Value
strJmeno = .Range("B1").Value
End With
VytvorAdresar strFolder
strCesta = strFolder & "\" & strJmeno & ".xlsm"
ThisWorkbook.SaveAs Filename:=strCesta, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub
Sub VytvorAdresar(Cesta As String)
Dim sC() As String, dC() As String, i As Byte
If Right$(Cesta, 1) <> "\" Then Cesta = Cesta & "\"
dC = Split(Cesta, ":\")
sC = Split(dC(1), "\")
Cesta = dC(0) & ":"
For i = 0 To UBound(sC)
If sC(i) <> "" Then
Cesta = Cesta & "\" & sC(i)
If Len(Dir(Cesta, vbDirectory)) = 0 Then MkDir Cesta
End If
Next i
End Sub
viď tu
Sub Ulozit()
Dim strCesta As String, strJmeno As String, strFolder As String
With wksUvod
strFolder = .Range("D1").Value & "\" & Year(.Range("B3").Value) & "\" & .Range("B2").Value
strJmeno = .Range("B1").Value
End With
VytvorAdresar strFolder
strCesta = strFolder & "\" & strJmeno & ".xlsm"
ThisWorkbook.SaveAs Filename:=strCesta, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub
Sub VytvorAdresar(Cesta As String)
Dim sC() As String, dC() As String, i As Byte
If Right$(Cesta, 1) <> "\" Then Cesta = Cesta & "\"
dC = Split(Cesta, ":\")
sC = Split(dC(1), "\")
Cesta = dC(0) & ":"
For i = 0 To UBound(sC)
If sC(i) <> "" Then
Cesta = Cesta & "\" & sC(i)
If Len(Dir(Cesta, vbDirectory)) = 0 Then MkDir Cesta
End If
Next i
End Sub
viď tu
Příloha: 
48828_zaklad.zip (15kB, staženo 19x)
citovat48828_zaklad.zip (15kB, staženo 19x)
RSS nejnovější články