AW: geschlossene Dateien auslesen
23.02.2010 11:46:42
Josef
Hallo Mario,
ich habe den Code erweitert. Du kannst jetzt pro Datei mehrere Zellen angeben, immer nach dem Schema "Pfad;Datei;Tabelle;1.Quellzelle;1.Zielzelle;2.Quellzelle;2.Zielzelle; ....."
Der obere Teil des Codes gehört in das Modul "DieseArbeitsmappe", der untere in ein allgemeines Modul.
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************
Option Explicit
Private Sub Workbook_Activate()
startTimer
End Sub
Private Sub Workbook_Deactivate()
stopTimer
End Sub
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Private Const cstrProc As String = "updateData"
Private Const clngInterval As Long = 10 'Intervall in Sekunden
Private cdblNextTime As Double
Sub startTimer()
cdblNextTime = Now + TimeSerial(0, 0, clngInterval)
Application.OnTime cdblNextTime, cstrProc
End Sub
Sub stopTimer()
On Error Resume Next
Application.OnTime cdblNextTime, cstrProc, Schedule:=False
On Error GoTo 0
End Sub
Sub updateData()
Dim strReference(1 To 10) As String, strSplit() As String
Dim intIndex As Integer, IntC As Integer
'INFO: strReference(1 To 10) anpassen an die Anzahl der Dateien (1 To n)
'INFO: Pfad;Datei;Tabelle;1.Quellzelle;1.Zielzelle;2.QuellZelle;2.Zielzelle; ...
strReference(1) = "E:\Forum;test.xls;Tabelle1;C5;A10;C6;B10"
strReference(2) = "E:\Forum;test1.xls;Tabelle3;F11;B10"
strReference(3) = "E:\Forum;test2.xls;Tabelle1;H5;C3"
strReference(4) = "E:\Forum;test3.xls;Tabelle2;C5;A11"
strReference(5) = "E:\Forum;test4.xls;Tabelle1;C5;A12"
strReference(6) = "E:\Forum;test5.xls;Tabelle4;C5;A13"
strReference(7) = "E:\Forum;test6.xls;Tabelle1;C5;A14"
strReference(8) = "E:\Forum;test7.xls;Tabelle3;C5;A15"
strReference(9) = "E:\Forum;test8.xls;Tabelle1;C5;A16"
strReference(10) = "E:\Forum;test9.xls;Tabelle1;C5;A17"
With ThisWorkbook.Sheets("Tabelle1") 'Zieltabelle
For intIndex = LBound(strReference) To UBound(strReference)
strSplit = Split(strReference(intIndex), ";")
For IntC = 3 To UBound(strSplit) - 1 Step 2
.Range(strSplit(IntC + 1)) = GetValue(strSplit(0), strSplit(1), strSplit(2), strSplit(IntC))
Next
Next
End With
startTimer
End Sub
Private Function GetValue(path As String, file As String, _
sheet As String, ref As String)
' Retrieves a value from a closed workbook
Dim arg As String
' Make sure the file exists
If Right(path, 1) <> "\" Then path = path & "\"
If Dir(path & file) = "" Then
GetValue = "File Not Found"
Exit Function
End If
' Create the argument
arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Range("A1").Address(, , xlR1C1)
' Execute an XLM macro
GetValue = ExecuteExcel4Macro(arg)
End Function
Gruß Sepp