Zugriff auf geschlossene Datei

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit ' von Alf Herber Forum ' https://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 & "]" & 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("A1") End Function

Public Function GetValue(MatNr, Werk, Zelle) ' Retrieves a value from a closed workbook Dim arg As String ' Make sure the file exists Select Case Werk Case "D" arg = "'R:\Sonderauswertungen\" & _ "Werk Düsseldorf\[Regeneratanalyse MatNr " & MatNr & ".xls]Tabelle1'!Range(" & Zelle & "). _ Value" Case "T" arg = "'R:\Sonderauswertungen\" & _ "Werk Turin\[Regeneratanalyse MatNr " & MatNr & ".xls]Tabelle1'!Range(" & Zelle & ").Value" Case "S" arg = "'R:\Sonderauswertungen\" & _ "Werk Schweinfurt\[Regeneratanalyse MatNr " & MatNr & ".xls]Tabelle1'!Range(" & Zelle & "). _ Value" Case "P" arg = "'R:\Sonderauswertungen\" & _ "Werk Prag\[Regeneratanalyse MatNr " & MatNr & ".xls]Tabelle1'!Range(" & Zelle & ").Value" Case Else arg = Null End Select GetValue = ExecuteExcel4Macro(arg) End Function

Hallo Hajo,
danke dir. Aber so hab ich es nicht hinbekommen: Ich habe es so gelöst: Das war zwar nicht ganz das was ich mir vorgestellt habe, es hat aber geklappt.
Danke dir trotzdem.
Lieben Gruss
Melissa
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 (strQuelle), _
vbExclamation, "Get data from closed Workbook"
GetDataClosedWB = False
End Function


Public Sub HoleDaten3()
Dim Pfad As String
Dim Dateiname As String
Dim Blatt As String
Dim MatNr As String
Dim Zeile As Long
Dim Ziel As String
Dim Werk As String
Dim i As Integer
Dim Wert As Boolean
Zeile = 3
MatNr = Worksheets("ABC Gruppe auf Artikel").Range("B3").Value
Do While IsNumeric(MatNr)
Werk = Worksheets("ABC Gruppe auf Artikel").Range("O" & Zeile).Value
Dateiname = "Regeneratanalyse MatNr " & MatNr & ".xls"
Blatt = "Tabelle1"
Select Case Werk
Case "D"
Pfad = "R:\Sonderauswertungen\" & _
"Werk Düsseldorf\"
Case "S"
Pfad = "R:\Sonderauswertungen\" & _
"Werk Schweinfurt\"
Case "T"
Pfad = "R:\Sonderauswertungen\" & _
"Werk Turin\"
Case "P"
Pfad = "R:\Sonderauswertungen\" & _
"Werk Paris\"
End Select
If Len(Dir(Pfad & Dateiname)) > 1 Then
For i = 1 To 2
If i = 1 Then
Wert = GetDataClosedWB(Pfad, Dateiname, Blatt, "L8", Worksheets("ABC Gruppe auf Artikel"). _
Range("P" & Zeile))
Else
Wert = GetDataClosedWB(Pfad, Dateiname, Blatt, "L7", Worksheets("ABC Gruppe auf Artikel"). _
Range("Q" & Zeile))
End If
Next i
End If
Zeile = Zeile + 1
MatNr = Worksheets("ABC Gruppe auf Artikel").Range("B" & Zeile).Value
Loop
End Sub

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

301 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zugriff auf geschlossene Datei

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

301 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread