Sub AusführenUpdate()
Call INFOHOLEN
Call Ausfuhren
End Sub
Sub INFOHOLEN()
Sheets("DATA2").Select
Dim fs As Object
Dim fVerz As Object
Dim fDatei As Object
Dim fdateien As Object
Dim strDat As String
Dim Zeile As Integer
Set fs = CreateObject("scripting.FileSystemObject")
Set fVerz = fs.getFolder("\\data\users\Privat\OUTLOOK FILES")
Set fdateien = fVerz.Files
For Each fDatei In fdateien
If InStr(fDatei, "TeamA-" & Format(Now, "YYYYMMDD")) > 0 Then
Zeile = Zeile + 50
Cells(Zeile, 1) = fDatei.Name
End If
Next fDatei
End Sub
Sub Ausfuhren()
Dim pfad As String, datei As String, blatt As String, bereich As Range, zelle As Object
pfad = "\\data\users\Privat\OUTLOOK FILES"
datei = Range("A50")
blatt = "Resume"
Set bereich = Range("A3:U11")
For Each zelle In bereich
zelle = zelle.Address(False, False)
ActiveSheet.Cells(zelle.Row + 47, zelle.Column).Value = GetValue(pfad, datei, blatt, zelle)
Next zelle
End Sub
Private Function GetValue(pfad, datei, blatt, zelle)
Dim arg As String
If Right(pfad, 1) <> "\" Then pfad = pfad & "\"
If Dir(pfad & datei) = "" Then
GetValue = "datei Not Found"
Exit Function
End If
arg = "'" & pfad & "[" & datei & "]" & blatt & "'!" & Range(zelle).Range("A1").Address(, , xlR1C1)
GetValue = ExecuteExcel4Macro(arg)
Sheets("WELCOME").Select
End Function