AW: 2 Daten aus mehrern Datein
11.12.2008 11:10:32
fcs
Hallo Thomas,
im Prinzip gibt es hier schon so was im Forum.
Problem ist evtl. den dateinamen im Link für das lesen sauber auszulesen.
Hier mein Vorschlag. Die Daten werden dabei aus dem jeweils 1. Tabellenblatt der Datei uzum Link ausgelesen.
gruß
Franz
Sub DatenHolen()
Dim wbQuelle As Workbook, wksQuelle As Worksheet, strQuelle As String
Dim wks As Worksheet, Zeile As Long, ZeileLetzte As Long
Set wks = ActiveWorkbook.Worksheets("Tabelle1")
On Error GoTo Fehler
With wks
ZeileLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
For Zeile = 2 To ZeileLetzte
strQuelle = .Cells(Zeile, 1).Hyperlinks(1).Address
'Prüfung, ob Hyperlink-datei im gleichen Verzeichnis wie aktive Datei.
If InStr(1, strQuelle, Application.PathSeparator) = 0 Then
strQuelle = ActiveWorkbook.Path & Application.PathSeparator & strQuelle
End If
Application.StatusBar = "Datei " & Zeile - 1 & " von " & ZeileLetzte - 1 & ": " _
& strQuelle
Set wbQuelle = Workbooks.Open(Filename:=strQuelle, ReadOnly:=True)
Set wksQuelle = wbQuelle.Worksheets(1)
.Cells(Zeile, 2).Value = wksQuelle.Range("E2").Value
.Cells(Zeile, 3).Value = wksQuelle.Range("S4").Value
wbQuelle.Close savechanges:=False
Resume01:
Next
End With
Fehler:
With Err
If .Number 0 Then
Select Case .Number
Case 1004
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description & "Datei " & strQuelle _
& " nicht gefunden!"
Resume Resume01
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End If
End With
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox "Fertig"
End Sub