Daten aus neuester Datei wenn geschlossen auslesen
04.12.2017 11:41:11
max
ich muss aus einem Ordner die neueste Datei auslesen (für jeden Monat wird automatisch eine neue erstellt mir jeweiligen Namen (....10-....;....11-....;...)
Ich habe mir schon aus ein paar Programmschnitzeln etwas zusammengebastelt, was aber nicht ganz optimal ist:
Sub DateienAuflisten()
Dim lngZeile As Long
Dim objFileSystem As Object
Dim objVerzeichnis As Object
Dim objDateienliste As Object
Dim objDatei As Object
Set objFileSystem = CreateObject("scripting.FileSystemObject")
Set objVerzeichnis = objFileSystem.GetFolder("C:\Users\ElAu\Desktop\Maxi\Excel\E1 Täglich\")
Set objDateienliste = objVerzeichnis.Files
lngZeile = 10
For Each objDatei In objDateienliste
If Not objDatei Is Nothing Then
ActiveSheet.Cells(lngZeile, 1) = objDatei.Name
lngZeile = lngZeile + 1
End If
Next objDatei
End Sub
Public Function GetDataClosedWB(SourcePath As String, _
SourceFile As String, _
sourceSheet As String, _
SourceRange As String, _
TargetRange As Range) As Boolean
Dim strQuelle As String
Dim Zeilen As Long
Dim Spalten As Byte
On Error GoTo InvalidInput
strQuelle = "'" & SourcePath & "[" & Replace(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 HoleDaten3()
Dim Pfad As String
Dim Dateiname As String
Dim Blatt As String
Dim Zellen As String
Dim Neueste_Datei As Variant
Neueste_Datei = Workbooks("Dragramm Goldi.xlsm").Worksheets("Tabelle1").Range("A16").Value
Pfad = "C:\Users\ElAu\Desktop\Maxi\Excel\E1 Täglich\"
Dateiname = Neueste_Datei
Blatt = "2017-10 E1 Täglich"
Zellen = "C2:BN3000"
If GetDataClosedWB(Pfad, _
Dateiname, _
Blatt, _
Zellen, _
Worksheets("Tabelle1").Range("C2:BN3000")) Then
MsgBox "Daten importiert"
End If
End Sub
Vielen dank im voraus!
MfG Max