Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1324to1328
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Verzeichnis Importieren_nur best. Dateien öffnen

Verzeichnis Importieren_nur best. Dateien öffnen
02.08.2013 10:12:48
Karl-Ludwig
Hi und guten Morgen allerseits,
ich importiere aus einem Verzeichnis alle abgelegten Exceldateien.
Um doppelte Einträge zu vermeiden, würde ich die Dateien nach dem Import umbenennen (z.B. ein "A_" vor den Dateinamen setzen)
Die eigentlichen Daten beginnen mit Ziffern.
Wie kann ich Ecel anweisen nur daten zu öffnen deren Namen mit Ziffern beginnen.
Format des Dateinamens: XX_JJJJMMDD_Produkt.xls
XX= fortlaufende Nummer
Hat jemand eine Idee?
Grüssle aus Mannheim
KL

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Ansatz zur Auswahl
02.08.2013 11:51:21
Frank88
Hallo Karl-Ludwig,
für den folgenden Code müsstest Du sicher stellen, dass die Dateinamen mit zweistelligen Zahlen beginnen. Andernfalls Remark nach For-Each-Zeile beachten.
Sub test1()
Pfad = DeinPfad
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.getfolder(Pfad)
Set fl = f.Files
For Each Datei In fl
'Suchkriterium folgt, evtl mit INSTR den Unterstrich suchen
'und mit diesem Rückgabewert-1 den Parameter für LEFT anpassen
FNS = Left(Datei.Name, 2)
If IsNumeric(FNS) Then
MsgBox "Hier muss dann der Code hin" & Chr(32) & _
"zum Umbenennen der Dateien"
End If
Next
End Sub
Grüsse, Frank

Anzeige
AW: Ansatz zur Auswahl
02.08.2013 13:12:25
Karl-Ludwig
Hallo Frank,
Wunderbar!
Sub test1()
On Error GoTo fehler
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim Pfad As String, Dateiname As String, iRow As Long, Ordner As String, Datum As String
Dim fs
Dim f
Dim fl
Dim Datei
Dim FNS
Ordner = InputBox("Ordner angeben (z.B. 07_2013)")
Pfad = "L:\Produktion\" & Ordner & "\"
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.getfolder(Pfad)
Set fl = f.Files
For Each Datei In fl
'Suchkriterium folgt, evtl mit INSTR den Unterstrich suchen
'und mit diesem Rückgabewert-1 den Parameter für LEFT anpassen
FNS = Left(Datei.Name, 2)
If IsNumeric(FNS) Then
Dateiname = Dir(Pfad & "*.xls")
GetObject (Datei)
Datum = Workbooks(Dateiname).BuiltinDocumentProperties("last save time")
iRow = ThisWorkbook.Sheets("Tabelle1").Range("A65536").End(xlUp).Offset(1, 0).Row
ThisWorkbook.Sheets("Tabelle1").Cells(iRow, 1) = Datum
Workbooks(Dateiname).Sheets("Tabelle1").Range("D5").Copy
ThisWorkbook.Sheets("Tabelle1").Cells(iRow, 2).PasteSpecial Paste:=xlPasteValues
Workbooks(Dateiname).Sheets("Tabelle1").Range("D6").Copy
ThisWorkbook.Sheets("Tabelle1").Cells(iRow, 3).PasteSpecial Paste:=xlPasteValues
Workbooks(Dateiname).Sheets("Tabelle1").Range("H6").Copy
ThisWorkbook.Sheets("Tabelle1").Cells(iRow, 4).PasteSpecial Paste:=xlPasteValues
Workbooks(Dateiname).Sheets("Tabelle1").Range("I6").Copy
ThisWorkbook.Sheets("Tabelle1").Cells(iRow, 5).PasteSpecial Paste:=xlPasteValues
Workbooks(Dateiname).Sheets("Tabelle1").Range("H7").Copy
ThisWorkbook.Sheets("Tabelle1").Cells(iRow, 6).PasteSpecial Paste:=xlPasteValues
Workbooks(Dateiname).Sheets("Tabelle1").Range("I7").Copy
ThisWorkbook.Sheets("Tabelle1").Cells(iRow, 7).PasteSpecial Paste:=xlPasteValues
Workbooks(Dateiname).Sheets("Tabelle1").Range("I34").Copy
ThisWorkbook.Sheets("Tabelle1").Cells(iRow, 8).PasteSpecial Paste:=xlPasteValues
Workbooks(Dateiname).Sheets("Tabelle1").Range("I35").Copy
ThisWorkbook.Sheets("Tabelle1").Cells(iRow, 9).PasteSpecial Paste:=xlPasteValues
Workbooks(Dateiname).Sheets("Tabelle1").Range("I36").Copy
ThisWorkbook.Sheets("Tabelle1").Cells(iRow, 10).PasteSpecial Paste:=xlPasteValues
Workbooks(Dateiname).Sheets("Tabelle1").Range("I38").Copy
ThisWorkbook.Sheets("Tabelle1").Cells(iRow, 11).PasteSpecial Paste:=xlPasteValues
Workbooks(Dateiname).Sheets("Tabelle1").Range("G38").Copy
ThisWorkbook.Sheets("Tabelle1").Cells(iRow, 12).PasteSpecial Paste:=xlPasteValues
Workbooks(Dateiname).Sheets("Tabelle1").Range("J38").Copy
ThisWorkbook.Sheets("Tabelle1").Cells(iRow, 13).PasteSpecial Paste:=xlPasteValues
Workbooks(Dateiname).Sheets("Tabelle1").Range("C10").Copy
ThisWorkbook.Sheets("Tabelle1").Cells(iRow, 14).PasteSpecial Paste:=xlPasteValues
'ThisWorkbook.Sheets("Tabelle1").Cells(iRow, 15).Hyperlinks.Add Anchor:=Selection, _
Address:="Pfad & Dateiname", TextToDisplay:="Dateiname"
Workbooks(Dateiname).Close False
Name Pfad & Dateiname As Pfad & "A_" & Dateiname
Dateiname = Dir()
fehler:
Application.Calculation = xlCalculationAutomatic
End If
Next
End Sub
Hast Du noch eine Idee zu der Zeile?:
ThisWorkbook.Sheets("Tabelle1").Cells(iRow, 15).Hyperlinks.Add Anchor:=Selection, Address:=" _
Pfad & Dateiname", _
TextToDisplay:="Dateiname"
Das mit dem Hyperlink funktioniert nicht :-(
Vielen Dank+ Gruß
KL

Anzeige
AW: Ansatz zur Auswahl
02.08.2013 13:52:40
Frank88
Hallo KL,
Hyperlinks funktionieren bei mir noch nicht mal immer, wenn ich's per Hand eingebe...
;-)
Selection.Hyperlinks.Add Anchor:=ThisWorkbook.Sheets("Tabelle1").Cells(iRow, 15), Address:=" _
Pfad & Dateiname", _
TextToDisplay:="Dateiname"

könnte klappen. Oder mit
ThisWorkbook.Sheets("Tabelle1").Cells(iRow, 15).Select

die Zelle selektieren und dann
Selection.Hyperlinks.Add Anchor:=Selection, Address:= _
Pfad & Dateiname", _
TextToDisplay:="Dateiname"
Auf jeden Fall hat das was mit der 'selection' zu tun. Wieso die erste Variante klappt, ist mir ein Rätsel, weil tatsäclich nix gewählt ist, bzw. nicht die Zelle, in die dann geschrieben wird.
Grüsse, Frank

Anzeige
AW: Ansatz zur Auswahl
02.08.2013 13:56:50
Rudi
Hallo,
ich denke so:
ThisWorkbook.Sheets("Tabelle1").Cells(iRow, 15).Hyperlinks.Add Anchor:=Selection, _
Address:=Pfad & Dateiname, TextToDisplay:=Dateiname
Gruß
Rudi

Gänsefüsschen und Augenkrebs
02.08.2013 14:05:38
Frank88
Hallo Rudi,
die Gänsefüsschen hatte ich total übersehen. Trotzdem witzig, dass die Variante mit der Selection, die keine ist und der Ankerzelle funktioniert. Hyperlink eben. Da wird man gelinkt!
Grüsse, Frank

AW: Gänsefüsschen und Augenkrebs
02.08.2013 15:00:49
Karl-Ludwig
Ich bin zwar nicht Rudi,
aber der Code war trotzdem richtig :-)
Die Gänsefüsschen- sorry, da hätte ich selbst drauf kommen müssen :-/
ThisWorkbook.Sheets("Tabelle1").Cells(iRow, 15).Select
Selection.Hyperlinks.Add Anchor:=Selection, _
Address:=Pfad & "A_" & Dateiname, TextToDisplay:="A_" & Dateiname
Nur noch eine kleine Anmerkung- oder vielleicht Frage:
Application.ScreenUpdating = False
ist dabei scheinbar ausser Kraft gesetzt- zumindest flackert der Bildschirm seit der Hyperlink- Geschichte
Vielen Dank für Deine Hilfe+ schönes Wochenende
KL
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige