• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

MS Excel

Téma: Prověření existence adresáře

Zaslal/a Onykl 12.10.2021 11:19

Dobrý den,

napsal jsem si funkci pro ověřování existence složky na disku.
Cesty jsou generované excelem a vše je plně funkčí.

Poprosil bych, zdy by někdo koukl a případně předal nějaké připomínky.

Děkuji.



Function KontrolaExistenceSlozkyZakazky()

Dim cell As Range
Dim rng As Range

'Definování Aktivního řádku
R = ActiveCell.Row

'Proměné
VyrobniCisloRozvadece = Cells(R, 1)
ZakaznikAkce = Cells(R, 2)
AktualniRok = Format(Now, "yyyy")
ZakazkoveCislo = Mid(VyrobniCisloRozvadece, 1, 4)

OdstranMezeruZakaznikAkce = WorksheetFunction.Trim(ZakaznikAkce)
CistyTvarZakaznikAkce = KontrolaZnaku("" & OdstranMezeruZakaznikAkce & "")

Sheets("Config").Visible = True

ZvolenyAdresar = Workbooks(ZakazkovaKniha).Sheets("Config").Range("route_disc")

Sheets("Temp").Visible = True
Application.ScreenUpdating = False
Workbooks(ZakazkovaKniha).Sheets("Temp").Activate
ActiveSheet.Range("F1").Select


Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(ZvolenyAdresar)
Set fc = f.SubFolders
For Each f1 In fc
polozka = f1.Name

ActiveCell.Value = polozka
ActiveCell.Offset(1, 0).Select

Next
Range("F:F").Find("System Volume Information").Delete Shift:=xlUp

PosledniPlnyRadek = Cells(Rows.Count, "F").End(xlUp).Row + 1 ' Ve sloupci F



Set rng = Workbooks(ZakazkovaKniha).Sheets("Temp").Range("F1:F" & PosledniPlnyRadek & "")

Workbooks(ZakazkovaKniha).Sheets("Kniha zakázek").Activate

For Each cell In rng

UmisteniSlozkyZakazkyArr = ZvolenyAdresar & cell.Value & "\" & ZakazkoveCislo & "-" & CistyTvarZakaznikAkce & ""

If Len(Dir(UmisteniSlozkyZakazkyArr, vbDirectory)) = 0 Then
'Nenalezena
Else
KontrolaExistenceSlozkyZakazky = UmisteniSlozkyZakazkyArr
'MsgBox (KontrolaExistenceSlozkyZakazky)

Exit For

End If

If cell.Value = "" Then
MsgBox ("Složka nenalezena")
End If

Next cell


Sheets("Config").Visible = False
Sheets("Temp").Visible = False
Workbooks(ZakazkovaKniha).Sheets("Kniha zakázek").Activate
Application.ScreenUpdating = True

End Function

Zaslat odpověď >

---

elninoslov(12.10.2021 12:58)#051339

1. Priložte aj nejaký súbor bez citlivých dát (no nie bez dát!), nech si vieme urobiť predstavu, kde čo je, a čo sa asi tak má robiť.
2. Čo sa má robiť ??? Lepší popis.

Samotné overenie existencie zložky sa dá urobiť aj jednoducho cez Len(Dir(...))=0, ale tu čarujete niečo s bunkami, a bez prílohy sa mi nechce hádať.

EDIT:
Workbooks(ZakazkovaKniha) bude vždy otvorený?
.Select nepoužívajte, ak to nie je nevyhnutné. Použite súradnicové adresovanie bunky cez Cells(y,x)
Nepoužívajte iba Next, ale radšej Next f1. Nepomýlite si tak cykly.
Čo ak Find("System Volume Information") nenájde nič - chyba. Treba ošetriť cez On Error
Raz používate Cells() a hneď na to Workbooks(ZakazkovaKniha)... Je dobré makru určiť, ktorý zošit/list sa spracováva. Nie iba samotné Range/Cells ale aj zošit/list
Chýba funkcia KontrolaZnaku.
...
Bez prílohy + popisu + vzorových dát ani ranu...citovat

Onykl(12.10.2021 13:20)#051341

Je to trochu oholené, funkcí už je hodně a bylo by to nepřehledné.

Podstatné zůstalo.

Příloha: 51341_kniha.zip (288kB, staženo 15x)

citovat

Onykl(12.10.2021 13:25)#051342

V kartě > Elektrotrend > Nastavení lze upravit adresářovou strukturu a následně simulovat chování.citovat

Milan-158(14.10.2021 16:20)#051344

Zdar,
je mi záhadou jak jsi vytvořil tu kartu Elektrotrend, která se zjeví na Ribbonu po otevření souboru
Ty tlačítka na kartě jsou sice mrtvé, neboť chybí kód, ale ani v ThisWorkbook není žádný kód pro vytvoření této karty, ani v modulech ani v modulech listů ani ve formulářích.
Co je to za trik?

Předem dík, M.citovat

Stalker(14.10.2021 20:30)#051345

@Milan-158

https://wall.cz/excel-navod/prizpusobeni-pasu-karet-ribbon-vlastni-pas-karetcitovat

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse