< návrat zpět

MS Excel

Téma: MsgBox kontrola souborů rss

Zaslal/a stejzi 18.2.2025 9:18

Zdravím, už si nevím rady. Mám makro. Zkontroluje jestli soubory existují, pak ukáže kdy byly naposledy aktualizované a nakonec spustí nebo nespustí makro. Nemůžu přijít na to, aby mě v MSgBoxu zobrazoval jenom soubory, které neexistují. Jakmile chybí jeden, zobrazí všechny. Nevím jak to zapsat. Díky za pomoc.

Sub AktualizaceDat()

Dim Cesta As String
Dim Soubor1 As String
Dim Soubor2 As String
Dim Soubor3 As String

Cesta = ThisWorkbook.Path & "\"
Soubor1 = "01.xlsx"
Soubor2 = "02.xlsx"
Soubor3 = "03.xlsx"

If Len(Dir(Cesta & Soubor1, vbNormal)) = 0 _
Or Len(Dir(Cesta & Soubor2, vbNormal)) = 0 _
Or Len(Dir(Cesta & Soubor3, vbNormal)) = 0 Then

MsgBox "Soubor:" & vbCrLf & vbNewLine & Soubor1 & vbCrLf & Soubor2 & vbCrLf & Soubor3 & vbCrLf & vbCrLf & "neexistuje.", vbCritical, "Kontrola souborů."

Else

I = MsgBox(Soubor1 & " - " & FileDateTime(Cesta & Soubor1) & vbCrLf & _
Soubor2 & " - " & FileDateTime(Cesta & Soubor2) & vbCrLf & _
Soubor3 & " - " & FileDateTime(Cesta & Soubor3) & vbCrLf & vbCrLf & _
"Zahájit aktualizaci?", vbYesNo, "Vygenerováno.")

Select Case I
Case vbNo
Exit Sub
Case vbYes
MsgBox ("Call Aktualizace")
'Call Aktualizace
End Select
End If

End Sub

Zaslat odpověď >
€Ł мσşqμΐτσ(18.2.2025 9:42)#057269
€Ł мσşqμΐτσ
opravené makro,
samozřejmě pokud by těch souborů bylo víc, chtělo by ten kód přepsat (zjednodušit)
Sub AktualizaceDat()

Dim Cesta As String
Dim Soubor1 As String, Soubor2 As String, Soubor3 As String
Dim ChybejiciSoubory As String
Dim I As Integer

Cesta = ThisWorkbook.Path & "\"
Soubor1 = "01.xlsx"
Soubor2 = "02.xlsx"
Soubor3 = "03.xlsx"

' Inicializace prázdného řetězce pro chybějící soubory
ChybejiciSoubory = ""

' Kontrola existence souborů a přidání chybějících do seznamu
If Len(Dir(Cesta & Soubor1, vbNormal)) = 0 Then ChybejiciSoubory = ChybejiciSoubory & vbCrLf & Soubor1
If Len(Dir(Cesta & Soubor2, vbNormal)) = 0 Then ChybejiciSoubory = ChybejiciSoubory & vbCrLf & Soubor2
If Len(Dir(Cesta & Soubor3, vbNormal)) = 0 Then ChybejiciSoubory = ChybejiciSoubory & vbCrLf & Soubor3

' Pokud nějaký soubor chybí, zobrazíme pouze ty chybějící
If ChybejiciSoubory <> "" Then
MsgBox "Následující soubory neexistují:" & vbCrLf & ChybejiciSoubory, vbCritical, "Kontrola souborů"
Exit Sub
End If

' Pokud všechny soubory existují, zobrazíme datum poslední aktualizace a dotaz na aktualizaci
I = MsgBox(Soubor1 & " - " & FileDateTime(Cesta & Soubor1) & vbCrLf & _
Soubor2 & " - " & FileDateTime(Cesta & Soubor2) & vbCrLf & _
Soubor3 & " - " & FileDateTime(Cesta & Soubor3) & vbCrLf & vbCrLf & _
"Zahájit aktualizaci?", vbYesNo, "Vygenerováno.")

Select Case I
Case vbNo
Exit Sub
Case vbYes
MsgBox "Call Aktualizace"
'Call Aktualizace
End Select
End Subcitovat
stejzi(18.2.2025 10:15)#057271
avatar
Super, díkycitovat

Uživatelské menu

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

Menu

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.

On-line nástroje