01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45 |
|
Option Explicit
Private Function GetValue(Pfad, Datei, Blatt, Zelle)
Dim arg As String
If Right(Pfad, 1) <> "\" Then Pfad = Pfad & "\"
If Dir(Pfad & Datei) = "" Then
GetValue = "Wochenende"
Exit Function
End If
arg = "'" & Pfad & "[" & Datei & "]" & Blatt & "'!" & Range(Zelle).Range("A1").Address(, , xlR1C1)
GetValue = ExecuteExcel4Macro(arg)
End Function
Private Function DateiGeoeffnet(DerPfad As String) As Boolean
On Error Resume Next
Open DerPfad For Binary Access Read Lock Read As #1
Close #1
If Err.Number <> 0 Then
DateiGeoeffnet = True
Err.Clear
End If
End Function
Sub Zellen_auslesen()
Dim Pfad As String, Datei As String, Blatt As String
Pfad = "C:\"
Datei = "03.xlsm"
Blatt = "Tabelle1"
If Dir$(Pfad & Datei) = "" Then
MsgBox "Achtung!" & vbLf & vbLf _
& "Die Quelldatei existiert nicht!", vbCritical, "Daten aktualisieren"
ElseIf DateiGeoeffnet(Pfad & Datei) Then
MsgBox "Achtung!" & vbLf & vbLf _
& "Die Quelldatei ist geöffnet, daher erfolgt keine Aktualisierung!", vbCritical, "Daten aktualisieren"
Else
ActiveSheet.Range("C8") = GetValue(Pfad, Datei, Blatt, "N11")
ActiveSheet.Range("D8") = GetValue(Pfad, Datei, Blatt, "S11")
End If
End Sub
|