A zas tu chybí základní: Vy nevíte, co hledáte? Pak je asi něco špatně. Ale AI to jistě vyřeší.citovat
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: Kontrola existencie suboru v hociakom formate
A prečo to hovoríš až teraz?citovat
MS Excel
Téma: Kontrola existencie suboru v hociakom formate 
Zaslal/a Durikam 5.9.2019 7:54
Urobil som makro:
Sub fileExistsFSORange()
Dim Rng As Range
Set fso_obj = CreateObject("Scripting.FileSystemObject")
Set Rng = Selection
For Each Cell In Rng
If fso_obj.fileExists(Cell) Then
Cell.Font.Color = vbGreen
Else
Cell.Font.Color = vbRed
End If
Next Cell
End Sub
takze ked do bunky napisem cestu suboru napr J:\zlozka\subor.pdf, a spustim makro tak mi overi ci existuje. Potreboval by som ale aby mi hladalo subory
bez zadefinovania formatu suboru. Skusal som J:\zlozka\subor.* ale to nefunguje.
Strana: « předchozí 1
2
(5.9.2019 16:47)#044185
Mozete sa mi este pozriet na funkciu?
Sub fileExistsFSORange()
Dim Rng As Range
Set fso_obj = CreateObject("Scripting.FileSystemObject")
Set Rng = Selection
For Each Cell In Rng
Filename = Cell & "*"
file = Dir(Filename)
If file = "" Then
Cell.Font.Color = vbRed
Else
Cell.Font.Color = vbGreen
End If
Next Cell
End Sub
Function FileExists(full_path As String)
Dim fso_obj As Object
Set fso_obj = CreateObject("Scripting.FileSystemObject")
FileExists = fso_obj.FileExists(full_path)
End Function
Funkcia by mala v bunke napisat true/false, podla toho ci subor existuje ale stale pise len false.citovat
Sub fileExistsFSORange()
Dim Rng As Range
Set fso_obj = CreateObject("Scripting.FileSystemObject")
Set Rng = Selection
For Each Cell In Rng
Filename = Cell & "*"
file = Dir(Filename)
If file = "" Then
Cell.Font.Color = vbRed
Else
Cell.Font.Color = vbGreen
End If
Next Cell
End Sub
Function FileExists(full_path As String)
Dim fso_obj As Object
Set fso_obj = CreateObject("Scripting.FileSystemObject")
FileExists = fso_obj.FileExists(full_path)
End Function
Funkcia by mala v bunke napisat true/false, podla toho ci subor existuje ale stale pise len false.citovat
Function FileExists(full_path As String)
full_path - obsahuje skutečně celou cestu s úplným názvem souboru?citovat
full_path - obsahuje skutečně celou cestu s úplným názvem souboru?citovat
Vlastne. Nema format suboru. Ako to tam upravit aby nerozlisovalo format suboru?citovat
Prečo stále tvrdošijne trváte na FSO? Ten na to vôbec nieje vhodný, lebo by ste musel cyklom kontrolovať pri každom volaní všetky súbory v adresári po jednom. Čo je pomalé, hlavne pri viacnásobnom volaní z viacerých buniek. Použite obdobu Dir z príkladu, čo som Vám urobil minule presne na mieru. Tu máte jej úpravu na True/False.
Function FileExists(full_path As String)
Dim V, Pos As Integer, tmp() As String, Nazov As String
If full_path <> "" Then
tmp = Split(full_path, Application.PathSeparator)
Nazov = tmp(UBound(tmp))
Pos = InStrRev(Nazov, ".")
FileExists = Len(Dir(Left$(full_path, Len(full_path) - IIf(Pos = 0, 0, Len(Nazov) - Pos - 1)) & "*")) > 0
End If
End Functioncitovat
Function FileExists(full_path As String)
Dim V, Pos As Integer, tmp() As String, Nazov As String
If full_path <> "" Then
tmp = Split(full_path, Application.PathSeparator)
Nazov = tmp(UBound(tmp))
Pos = InStrRev(Nazov, ".")
FileExists = Len(Dir(Left$(full_path, Len(full_path) - IIf(Pos = 0, 0, Len(Nazov) - Pos - 1)) & "*")) > 0
End If
End Functioncitovat
Ked skusam elninoslov(5.9.2019 15:56) tak to nefunguje.
Pise nedefinovany sub alebo funkcia a oznaci AddColorcitovat
Pise nedefinovany sub alebo funkcia a oznaci AddColorcitovat
Ach áno, samozrejme. Pretože, to som postoval iba upravenú procedúru CheckExists, vychádzajúcu z postu (5.9.2019 12:39). Rovnako ako aj ďalšie 2 úpravy (5.9.2019 14:45) vychádzajú z pôvodného postu (5.9.2019 12:39). V ňom je malá pomocná procedúra AddColor, ktorá je v ďalších upravených postoch nemenná. A zaujímavé, že po takej dobe a toľkých mojich úpravách zisťujem, že ste ich ani netestoval, lebo by Vám predsa tá AddColor chýbala aj v ostatných návrhoch. A načo sa tu potom snažím?
Slúži na pridanie bunky k ostatným zafarbovaným, aby sa nefarbilo po jednej, čo je pomalé, ale všetky naraz.
PS: Túto procedúrku nepotrebuje len môj posledný návrh, lebo ten nič nefarbí, vracia True/False.citovat
Slúži na pridanie bunky k ostatným zafarbovaným, aby sa nefarbilo po jednej, čo je pomalé, ale všetky naraz.
PS: Túto procedúrku nepotrebuje len môj posledný návrh, lebo ten nič nefarbí, vracia True/False.citovat
Skusal som prve dve prispevky. Obidva fungovali rovnako, tak dalsie som uz neskusal. Uz to ide ale je tam jeden problem. Nazov suboru obsahuje bodku. B PVV0001N.32.pdf Takze to berie ze existuje vsetko co sa vola B PVV0001N.xxxcitovat
Durikam napsal/a:
Skusal som prve dve prispevky. Obidva fungovali rovnako, tak dalsie som uz neskusal. Uz to ide ale je tam jeden problem. Nazov suboru obsahuje bodku. B PVV0001N.32.pdf Takze to berie ze existuje vsetko co sa vola B PVV0001N.xxx
A prečo to hovoríš až teraz?citovat
V tom prípade vyskúšajte toto.
Function FileExists(full_path As String)
Dim tmp() As String, Nazov As String
Application.Volatile
If full_path <> "" Then
tmp = Split(full_path, Application.PathSeparator)
tmp = Split(tmp(UBound(tmp)), ".")
If UBound(tmp) < 1 Then Nazov = full_path Else Nazov = Left$(full_path, Len(full_path) - Len(tmp(UBound(tmp)))) & "*"
FileExists = Len(Dir(Nazov)) > 0
End If
End Functioncitovat
Function FileExists(full_path As String)
Dim tmp() As String, Nazov As String
Application.Volatile
If full_path <> "" Then
tmp = Split(full_path, Application.PathSeparator)
tmp = Split(tmp(UBound(tmp)), ".")
If UBound(tmp) < 1 Then Nazov = full_path Else Nazov = Left$(full_path, Len(full_path) - Len(tmp(UBound(tmp)))) & "*"
FileExists = Len(Dir(Nazov)) > 0
End If
End Functioncitovat
Strana: « předchozí 1
2
Uživatelské menu
Nejste přihlášen(a)
\n
\nMenu
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.
RSS nejnovější články