Makroanpassung
09.12.2008 09:42:19
Ernst
Dieser Code Funktioniert einwandfrei jedoch wird die Datei im Quellordner mit dem zuletzt angelegtem Datum abgefragt:
Ich würde es aber so geändert brauchen das die Datei mit dem Aktuellstem Datum als Bezugsdatei herangezogen wird.
Also nicht die zuletzt angelegte sondern die mit dem Aktuellstem Datum.
Beispiel:Jetzt läuft es so ab das ich im Quellordner Folgende Dateien habe 05.12.2008,06.12.2008 usw
lege ich jetzt den 04.12.2008 an oder ich rufe ein älteres Datum auf so nimmt er dieses als Bezugsdatei für die Aktualisierung und das ist genau das was ich nicht möchte sondern immer das aktuellste.
Wäre für Lösungsvorschläge Dankbar.
Lg.Ernst
Sub DatenHolen()
Dim wksQuelle As Worksheet, wksZiel As Worksheet
Const strFolder As String = "C:\Dokumente und Einstellungen\Ernst\Desktop\neuer ordner (2)" _
If MsgBox("Abgestellte Züge Aktualisieren?", vbYesNo, "Frage") = vbYes Then
Set wksZiel = ThisWorkbook.Sheets("Tabelle2")
Set wksQuelle = Workbooks.Open(NeuesteDatei(strFolder, ThisWorkbook.Name)).Sheets(1)
With wksQuelle
.Range("B5:B15").Copy
wksZiel.Range("O87").PasteSpecial xlPasteValues
.Range("D5:D15").Copy
wksZiel.Range("P87").PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
wksQuelle.Parent.Close False
End If
End Sub
Function NeuesteDatei(strPfad As String, Optional strIgnoredWkb As String) As String
Dim oFS As Object, oFolder As Object, oFile As Object
Dim dteMax As Date
Const strType As String = "*.xls"
Set oFS = CreateObject("scripting.filesystemobject")
Set oFolder = oFS.getfolder(strPfad)
For Each oFile In oFolder.Files
If oFile Like strType And oFile.datecreated > dteMax Then
dteMax = oFile.datecreated
NeuesteDatei = oFile
End If
Next
Set oFolder = Nothing
Set oFS = Nothing
End Function