AW: zu überprüfende Datei soll geschlossen bleiben
25.04.2010 14:15:39
Hajo_Zi
Hallo Torsten,
für den Zugriff auf geschlossene Dateien habe ich folgenden Code.
' ************************************************************* _
' Modul: mdl_Alf Typ = Allgemeines Modul
' **************************************************************
Option Explicit
' von Alf Herber Forum
' http://www.herber.de/forum/archiv/52to56/t52834.htm#52840
Sub TestGetValue()
Dim p As String
Dim f As String
Dim s As String
Dim r As String
p = "L:\Eigene Dateien\Hajo\"
f = "Adresse.xlsm"
s = "Adresse"
r = "B4"
' bennanter Bereich ergänzung von Nikhil Milo
' r = "Heinze"
MsgBox GetValue(p, f, s, r)
Worksheets("Tabelle1").Range("A1") = GetValue(p, f, s, r)
End Sub
Public Function _
GetValue(path, file, sheet, ref)
' 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)
' bennanter Bereich ergänzung von Nikhil Milo
' arg = "'" & path & "[" & file _
38; "]" & sheet & "'!" & ref
' Execute an XLM macro
GetValue = ExecuteExcel4Macro(arg)
End Function
Public Function _
Start(path, file, sheet, ref)
Worksheets("Tabelle1").Range("A1") = GetValue(path, file, sheet, ref)
Start = Worksheets("Tabelle1").Range _
40;"A1")
End Function
' **************************************************************
' Modul: mdl_ThomasRamel Typ = Allgemeines Modul
' **************************************************************
Option Explicit
Public Function GetDataClosedWB(SourcePath As String, _
SourceFile As String, sourceSheet As String, _
SourceRange As String, TargetRange As Range) As Boolean
'Holt einen Bereich aus einer _geschlossenen_ Arbeitsmappe
'Nur in VBA zu verwenden; nicht aus einer Tabellenzelle heraus
'© t.ramel@mvps.org
' wird durch die HoleDaten aufgerufen
Dim strQuelle As String
Dim Zeilen As Long
Dim Spalten As Byte
On Error GoTo InvalidInput
strQuelle = "'" & SourcePath & "[" & SourceFile & "]" & sourceSheet & "'!" & Range(SourceRange).Cells(1, 1).Address(0, 0)
Zeilen = Range(SourceRange).Rows.Count
Spalten = Range(SourceRange).Columns.Count
With TargetRange.Cells(1, 1).Resize(Zeilen, Spalten)
.Formula = "=IF(" & strQuelle & "="""",""""," & strQuelle & ")"
.Value = .Value
End With
GetDataClosedWB = True
Exit Function
InvalidInput:
MsgBox "Die Quelldatei oder der Quellbereich ist ungültig!", vbExclamation, "Get data from closed Workbook"
GetDataClosedWB = False
End Function
Public Sub HoleDaten()
' Die Funktion arbeitet mit der obrigen GetDataClosedWB zusammen
Dim Pfad As String
Dim Dateiname As String
Dim Blatt As String
Dim Bereich As String
Dim Ziel As Range
Pfad = "L:\Eigene Dateien\Hajo\Internet\Test\2009\"
Dateiname = "Beispiel Forum 30.xlsm" ' aus welcher Datei soll er holen?
Blatt = "Tabelle1" ' von welcher Tabelle soll er holen?
Bereich = "A1:B9" ' aus welchem Bereich soll er holen?
Set Ziel = ActiveSheet.Range("A1") ' in welchen Bereich soll er kopieren? Genauer gesagt: Bei welcher Zelle soll er anfangen, Datein reinzukopieren? Bsp: ActiveCell geht auch
If GetDataClosedWB(Pfad, Dateiname, Blatt, Bereich, Ziel) Then
MsgBox "Daten importiert"
End If
End Sub
