< návrat zpět

MS Excel


Téma: Kontrola existencie suboru v hociakom formate rss

Zaslal/a 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.

Zaslat odpověď >

Strana:  « předchozí  1 2
#044185
avatar
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
#044216
avatar
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
#044217
avatar
Function FileExists(full_path As String)

full_path - obsahuje skutečně celou cestu s úplným názvem souboru?citovat
#044218
avatar
Vlastne. Nema format suboru. Ako to tam upravit aby nerozlisovalo format suboru?citovat
#044220
elninoslov
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 Function
citovat
#044227
avatar
Ked skusam elninoslov(5.9.2019 15:56) tak to nefunguje.
Pise nedefinovany sub alebo funkcia a oznaci AddColorcitovat
#044229
elninoslov
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
#044243
avatar
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
#044244
avatar

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
#044247
elninoslov
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 Function
citovat

Strana:  « předchozí  1 2

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Aktivní diskuse

odpocet a storno tl.

PavDD • 28.3. 8:53

odpocet a storno tl.

Začátečník • 26.3. 14:39

odpocet a storno tl.

PavDD • 26.3. 10:22

odpocet a storno tl.

elninoslov • 26.3. 7:50

odpocet a storno tl.

PavDD • 26.3. 7:26

odpocet a storno tl.

elninoslov • 25.3. 22:34

odpocet a storno tl.

Začátečník • 25.3. 15:09