< návrat zpět

MS Excel


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

Zaslal/a 1.3.2022 18:17

LugrAhoj,

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ěď >

#052206
avatar
Nazev= "ZDROJ" (*.xls*)citovat
#052207
avatar
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
citovat
#052208
Lugr

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
#052210
avatar
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
#052211
avatar
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 Sub
citovat
#052212
Lugr
Teď si tady nad tím lámu hlavu.

Děkuji funguje super. 1citovat

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