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

MS Excel

Téma: Kopírování s libovolnou příponou

Zaslal/a Lugr 1.3.2022 18:17

Ahoj,

mám dotaz, pro kopírování z ext. souboru používám tento kód od "elninoslov". Problém je když se změní přípona. Jak mám zakomponovat, aby vyzkoušel všechny tři přípony?

Děkuji.

Sub Import()

Dim Cesta As String
Dim Nazev As String
Dim Soubor As String
Dim Zdroj As String

Cesta = "C:\Plocha\"
Nazev = "ZDROJ" (*.xls, * .xlsx, * .xlsm)

Soubor = Cesta & Nazev
If Dir(Soubor) = "" Then MsgBox "Soubor " & Soubor & " neexistuje!", vbCritical: Exit Sub

Zdroj = "'" & Cesta & "[" & Nazev & "]" & "List1" & "'!"

With Sheets("List1").Range("B2")
.Formula = "=IF(" & Zdroj & "B2" & "="""",""""," & Zdroj & "B2" & ")"
.Value = .Value
End With

End Sub

Zaslat odpověď >

---

Anonym(1.3.2022 20:15)#052206

Nazev= "ZDROJ" (*.xls*)citovat

r13(1.3.2022 20:31)#052207

Nápoveda:
If Len(Dir(Soubor & ".xls")) = 0 And Len(Dir(Soubor & ".xlsx")) = 0 And Len(Dir(Soubor & ".xlsm")) = 0 Then
MsgBox "Soubor " & Soubor & " neexistuje!", vbCritical
Exit Sub
Else: MsgBox "Soubor " & Soubor & " existuje!"
End Ifcitovat

Lugr(1.3.2022 20:57)#052208

r13 napsal/a:

Nápoveda:
If Len(Dir(Soubor & ".xls")) = 0 And Len(Dir(Soubor & ".xlsx")) = 0 And Len(Dir(Soubor & ".xlsm")) = 0 Then
MsgBox "Soubor " & Soubor & " neexistuje!", vbCritical
Exit Sub
Else: MsgBox "Soubor " & Soubor & " existuje!"
End If

Děkuju, ale tohle řeší ale pouze kontrolu existence souboru nikoliv samotný import (vzorec)citovat

r13(2.3.2022 6:35)#052210

Iste... Myslel som, že zvyšok si už budeš vedieť, na základe nápovedy, upraviť.
OK... Zvyšok Tvojho pôvodne uvedeného kódu funguje správne?citovat

r13(2.3.2022 7:59)#052211

Sub Import()
Dim Cesta As String
Dim Nazev As String
Dim Soubor As String
Dim Zdroj As String
Dim Pripona As String

Cesta = "C:\Plocha\"
Nazev = "ZDROJ"
Soubor = Cesta & Nazev

If Len(Dir(Soubor & ".xls")) = 0 And Len(Dir(Soubor & ".xlsx")) = 0 And Len(Dir(Soubor & ".xlsm")) = 0 Then
MsgBox "Soubor " & Soubor & " neexistuje!", vbCritical
Exit Sub
Else
If Len(Dir(Soubor & ".xls")) <> 0 Then Pripona = "xls"
If Len(Dir(Soubor & ".xlsx")) <> 0 Then Pripona = "xlsx"
If Len(Dir(Soubor & ".xlsm")) <> 0 Then Pripona = "xlsm"
End If

Zdroj = "'" & Cesta & "[" & Nazev & "." & Pripona & "]" & "List1" & "'!"

With Sheets("List1").Range("B2")
.Formula = "=IF(" & Zdroj & "B2" & "="""",""""," & Zdroj & "B2" & ")"
.Value = .Value
End With
End Subcitovat

Lugr(2.3.2022 8:17)#052212

Teď si tady nad tím lámu hlavu.

Děkuji funguje super. citovat

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

Formulář Faktura

Helios iNuvio

On-line nástroje