Office: (Office 2010) VBA: Aktuellste Excel-Datei öffnen mit "GetObject"

Hallo,

ich habe hier einen Code geschrieben bei den ich eine Excel-Datei mittels GetObject öffne und Daten in der Liste wo sich das Makro befindet abgleiche und in Spalten einfüge

Der Code:

Code:

Sub ZusatzdatenGSPR()
'Fügt Daten aus GSPR ein

Dim Zeile
Dim ZeileMax
Dim GSPR As String

ZeileMax = Tabelle2.UsedRange.Rows.Count

[COLOR="#FF0000"]GSPR = "Daten_Stand_27.01.2016.xlsx"[/COLOR]

GetObject ("C:\Mein Pfad\" & GSPR)

    With Tabelle2
    
        For Zeile = 2 To ZeileMax
         On Error Resume Next
         
            If .Cells(Zeile, 9) = "" Then
                .Cells(Zeile, 9) = Application.WorksheetFunction.Index(Workbooks(GSPR).Worksheets(1).Range("A:A"), _
                                    Application.WorksheetFunction.Match(Cells(Zeile, 1), Workbooks(GSPR).Sheets(1).Range("C:C"), 0))
            End If
            
            If .Cells(Zeile, 10) = "" Then
                .Cells(Zeile, 10) = Application.WorksheetFunction.VLookup(.Cells(Zeile, 1), _
                                            Workbooks(GSPR).Worksheets(1).Range("C:P"), 12, False)
            End If

            If .Cells(Zeile, 11) = "" Then
                .Cells(Zeile, 11) = Application.WorksheetFunction.VLookup(.Cells(Zeile, 1), _
                                            Workbooks(GSPR).Worksheets(1).Range("C:P"), 11, False)
            End If
            
            If .Cells(Zeile, 4) = "00858357" Then
                If .Cells(Zeile, 12) = "" Then
                    .Cells(Zeile, 12) = Application.WorksheetFunction.VLookup(.Cells(Zeile, 1), _
                                                Workbooks(GSPR).Worksheets(1).Range("C:P"), 13, False)
                End If
            End If
            
        Next Zeile
        
    End With

End Sub

In möchte hier meinen Dateinamen durch eine variabel ändern, sodass die aktuellste Datei abgerufen wird, entweder nach datecreated oder nach Datum im Dateinamen wie oben, je nachdem was leichter ist.

Also in den Order wo die Excel-Datei "Daten_Stand_TT.MM.JJJJ.xlsx" liegt, kommt ja jeden Tag eine aktuelle.

Mir wäre lieber wenn das nach datecreated abgerufen wird. Ich habe irgendwo gesehen, dass man das aktuellste Datum mit einem fso ermitteln kann aber keine Ahnung wie ich das in meinem Makro einbauen kann, sodass es läuft. Mit fso habe ich eben nicht so viel Erfahrung da ich auch Anfänger bin. Wenn möglich eine function vermeiden bitte.

Jemand vorschläge?

Danke im Voraus und mfg

Kiri

 

Hi Kiri,

vielleicht eine Möglichkeit zum Ermitteln der Datei mit dem jüngsten Erstelldatum:

Code:

Sub JuengsteMappe()
    Const strOrdner As String = "I:\Z_Test"
    Dim objShell As Object, objFolder As Object
    Dim varName, arrDateien(0), arrDatum(0)
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(strOrdner)
    For Each varName In objFolder.Items
        If varName.Type <> "Dateiordner" Then
            If CDate(objFolder.GetDetailsOf(varName, 4)) > arrDatum(0) Then
                If InStr(varName, "Daten_Stand_") > 0 Then
                    arrDateien(0) = varName
                    arrDatum(0) = CDate(objFolder.GetDetailsOf(varName, 4))
                End If
            End If
        End If
    Next
    MsgBox arrDatum(0) & vbLf & arrDateien(0)
    Set objShell = Nothing
    Set objFolder = Nothing
End Sub

Code berücksichtigt, ob Unterordner und/oder weitere Arbeitsmappen als die gewünschten mit dem Teilnamen "Daten_Stand_" vorhanden sind - diese werden ausgeklammert.
Falls noch andere als xlsx-Dateien vorhanden sind, dann musst dud as noch entsprechend berücksichtigen.

Bis später,
Karin

 

Hallo Karin, vielen Dank für deine Antwort. Nein es werden keine unterordner berücjsichtig. Eine Möglichkeit um das Datum zu ermitteln habe ich auch im Internet gefunden zwar mit Scripting.Filesystemobject aber funktioniert. Ich krieg es aber nicht hin den Code in meinem Makro (siehe meinem post oben) richtig einzubauen. Kannst du das vielleicht? LG Kiri

 

Hi,

1. kenne ich deinen Code nicht, den du aus dem Internet hast da du ihn nicht gepostet hast - deshalb kann ich auch nicht sagen, wie du ihn einbinden musst
2. habe ich einen Code gepostet, mit dem du das neuste Datum auslesen und den Namen der betreffende Mappe feststellen kannst - er steht im Array. Wenn du aus meinem Makro den Dateinamen an dein Makro übergeben willst, musst du am Code-Ende einfach nur diese Zeile ergänzen ZusatzdatenGSPR (arrDateien(0)) und dein Makro wandelst du in eine Sub mit Parameter um:

Code:

Sub ZusatzdatenGSPR([COLOR=#ff0000]GSPR As String[/COLOR])
    'Fügt Daten aus GSPR ein
    
    Dim Zeile
    Dim ZeileMax
    
    GetObject ("C:\Mein Pfad\" & GSPR)

    '...  hier dein restlicher Code


End Sub

Bis später,
Karin

 

Ich habe ihn doch gepostet oben im ersten Post mit [/code]

Hier nochmal ohne Code-Fenster

Sub ZusatzdatenGSPR()
'Fügt Daten aus GSPR ein

Dim Zeile
Dim ZeileMax
Dim GSPR As String

ZeileMax = Tabelle2.UsedRange.Rows.Count

GSPR = "Daten_Stand_27.01.2016.xlsx"

GetObject ("C:\Mein Pfad\" & GSPR)

With Tabelle2

For Zeile = 2 To ZeileMax
On Error Resume Next

If .Cells(Zeile, 9) = "" Then
.Cells(Zeile, 9) = Application.WorksheetFunction.Index(Workbooks(GSPR).Worksheets(1).Range("A:A"), _
Application.WorksheetFunction.Match(Cells(Zeile, 1), Workbooks(GSPR).Sheets(1).Range("C:C"), 0))
End If

If .Cells(Zeile, 10) = "" Then
.Cells(Zeile, 10) = Application.WorksheetFunction.VLookup(.Cells(Zeile, 1), _
Workbooks(GSPR).Worksheets(1).Range("C:P"), 12, False)
End If

If .Cells(Zeile, 11) = "" Then
.Cells(Zeile, 11) = Application.WorksheetFunction.VLookup(.Cells(Zeile, 1), _
Workbooks(GSPR).Worksheets(1).Range("C:P"), 11, False)
End If

If .Cells(Zeile, 4) = "00858357" Then
If .Cells(Zeile, 12) = "" Then
.Cells(Zeile, 12) = Application.WorksheetFunction.VLookup(.Cells(Zeile, 1), _
Workbooks(GSPR).Worksheets(1).Range("C:P"), 13, False)
End If
End If

Next Zeile

End With

End Sub

 

Zitat: In möchte hier meinen Dateinamen durch eine variabel ändern, sodass die aktuellste Datei abgerufen wird, entweder nach datecreated oder nach Datum im Dateinamen wie oben, je nachdem was leichter ist.

Dein geposteter Code aus deinem Eröffnungsbeitrag (und aus deinem letzten Beitrag) ist nicht der Code, in dem du das neuste Erstelldatum der Mappe ermittelst sondern ein Code, mit dem du eine bestimmte Arbeitsmappe öffnest (und darin etwas auführst).


Den Code zu diesem Beitrag von dir

Zitat: Eine Möglichkeit um das Datum zu ermitteln habe ich auch im Internet gefunden zwar mit Scripting.Filesystemobject aber funktioniert. Ich krieg es aber nicht hin den Code in meinem Makro (siehe meinem post oben) richtig einzubauen.

hast du nicht gepostet, also kann ihn auch niemand in dein anderes Makro einbinden.

Wie man das Gesamtproblem lösen kann (Ermitteln des neusten Erstelldatums und Übergabe des Mappennamens an deinen Code), habe ich im Beitrag Gestern, 19:19 gepostet.

Bis später,
Karin

 

Nun habe ich das gefunden.

Code:

Sub ZusatzdatenNeuesteGSPR()

Dim fso As Object
Dim f As Object
Dim GPSR As String
Dim Datum As Date
Dim Datei As String
Dim Pfad As String
Dim Zeile As Long
Dim ZeileMax As Long

Pfad = "C:\MyFiles\"

Set fso = CreateObject("Scripting.FileSystemObject")
GPSR = Dir(Pfad & "Testfile_Daten_Stand*" & "*.xlsx")

Do While Len(GPSR) > 0

    Set f = fso.GetFile(Pfad & GPSR)
    
        If Datum < f.datecreated Then
            Datum = f.datecreated
            Datei = f.Name
        End If
        
    GPSR = Dir()
    
Loop

ZeileMax = Tabelle2.UsedRange.Rows.Count

GetObject (Pfad & Datei)
    
    With Tabelle2
    
        For Zeile = 2 To ZeileMax
         On Error Resume Next
         
            If .Cells(Zeile, 9) = "" Then
                .Cells(Zeile, 9) = Application.WorksheetFunction.Index(Workbooks(Datei).Worksheets(1).Range("A:A"), _
                                    Application.WorksheetFunction.Match(Cells(Zeile, 1), Workbooks(Datei).Sheets(1).Range("C:C"), 0))
            End If
            
            If .Cells(Zeile, 10) = "" Then
                .Cells(Zeile, 10) = Application.WorksheetFunction.VLookup(.Cells(Zeile, 1), _
                                            Workbooks(Datei).Worksheets(1).Range("C:P"), 12, False)
            End If
            
            If .Cells(Zeile, 11) = "" Then
                .Cells(Zeile, 11) = Application.WorksheetFunction.VLookup(.Cells(Zeile, 1), _
                                            Workbooks(Datei).Worksheets(1).Range("C:P"), 11, False)
            End If
            
            If .Cells(Zeile, 4) = "00858357" Then
                If .Cells(Zeile, 12) = "" Then
                    .Cells(Zeile, 12) = Application.WorksheetFunction.VLookup(.Cells(Zeile, 1), _
                                                Workbooks(Datei).Worksheets(1).Range("C:P"), 13, False)
                End If
            End If
            
        Next Zeile
        
    End With
    
Set fso = Nothing
Set f = Nothing
    
End Sub

es funktioniert mit der letzen Datei.

Nun stehe ich schon vor dem nächsten Problem:

Ich möchte das gleiche Makro auch anderweitig benutzen aber diesmal sollen die aktuellsten drei Dateien angesprochen werden.
Wieder mal nach datecreated (also die letzten drei Dateien die erstellt worden sind.)
Hat jemand tipp?

Danke