AW: Datei laden
15.06.2007 17:27:00
Chaos
Servus Gerhard,
auf die Art leider nicht. Es gibt noch eine andere Mögkichkeit:
Sub suchen()
Dim Dateien As Integer
Dim DateiName As String, n As String, p As String
Dim zeile As Long
Dim Dateipfad As String
n = ActiveWorkbook.Name
p = ActiveWorkbook.Path
With Application.FileSearch
.NewSearch
.LookIn = "D:\Produktion\"
.SearchSubFolders = True
.Filename = "Messungen_" & "*" & ".xls"
If .Execute() > 0 Then
For Dateien = 1 To .FoundFiles.Count
DateiName = Dir(.FoundFiles(Dateien))
Dateipfad = .FoundFiles(Dateien)
If DateiName ThisWorkbook.Name Then
Workbooks.Open Filename:=.FoundFiles(Dateien)
Dim DateiName1 As String
DateiName1 = ActiveWorkbook.Name
With Workbooks(n)
On Error Resume Next
Dim gefunden As String
gefunden = Workbooks(n).Sheets("Info").Cells.Find(what:=DateiName1, LookAt: _
=xlPart, SearchOrder:=xlByRows, MatchCase:=False)
End With
If gefunden = ActiveWorkbook.Name Then
ActiveWorkbook.Close
Else
Workbooks(n).Sheets("Info").Range("A65536").End(xlUp).Offset(1, 0).Value = _
DateiName1
End If
End If
Next Dateien
End If
End With
With ActiveWorkbook
ActiveWorkbook.Sheets(1).Range("D2").Copy Destination:=Workbooks(n).Sheets(1).Range(" _
B5")
End With
End Sub
So geht es. Aber nur wenn die Zieldatei also die Startdatei immer dieselbe ist. Er macht jetzt folgendes:
Er öffnet alle Dateien (nacheinander), die mit Messungen_ anfangen und im Pfad D:\Produktion liegen.
Wenn eine Datei geöffnet wurde sucht er im Shets Info, ob der Dateiname drin steht, wenn ja schließt er die Datei wieder, wenn nein bleibt sie geöffnet und es erfolgt ein Eintrag in Tabelle "Info" und er kopiert den Wert aus D2 der Quelldatei in die Zieldatei nach B5.
Wie gesagt geht aber nur, wenn die Zieldatei immer dieselbe ist, da das Abgleichsverzeichnis in dieser Tabelle steht. Sonst weiß Excel ja nicht, welche Datei schonmal offen war.
Beim erstenmal öffnet das Makro alle Dateien dieser Art und läßt sie offen, weil ja noch nichts im Verzeichnis steht.
Gruß
Chaos