Code jeden Tag starten
18.06.2020 06:43:11
Charles
Ich habe den unten stehenden Code zum Laufen gebracht!!
Er ist in "DieserArbeitsmappe" "Allgemein" abgelegt.
Jetzt hätte ich gerne, dass der Code jeden Tag um 05:00 Uhr ausgeführt wird. Ich hab es schon mit OnTime versucht, aber irgendwie mache ich was falsch.
Bitte fügt mir eure Vorschläge direkt in meinen Code ein!
Vielen vielen Dank für eure Hilfe!!!!!!!
Sub GetData()
Set oMe = ThisWorkbook.ActiveSheet 'ZielDatei/-Tabelle (= die aktuelle Tabelle der aktuellen _
Datei)
Const sDateiPfad As String = "T:\20_Laboratory\TR\01_SK\01_P\" 'Pfad für zu durchsuchende Excel- _
Dateien; mit Backslash am Ende
sZelle1 = "B5" 'NOx 1. Temp.
sZelle2 = "B4" 'NOx 1. K-Wert.
sZelle3 = "C5" 'NOx 2. Temp.
sZelle4 = "C4" 'Nox 2. K-Wert.
sZelle5 = "D5" 'SOx 1. Temp.
sZelle6 = "D4" 'SOx 1. ETA
sZelle7 = "E5" 'SOx 2. Temp.
sZelle8 = "E4" 'SOx 2. ETA
sZelle9 = "F4" 'Porenvolumen.
sZelle10 = "G4" 'Abrieb
sZelle11 = "H4" 'BET
sZelle12 = "I4" 'Druckprüfung long.
sZelle13 = "J4" 'Druckprüfung trans.
sZelle14 = "K4" 'Vanadium ist
sZelle15 = "G2" 'Vanadium soll
sZelle16 = "A1" 'Auftragsnummer+Name
sZelle17 = "K1" 'Jahr
iZeile = 2 'ab Zeile 2 in Zieltabelle eintragen
iSpalte = 1 'ab Spalte A in Zieltabelle eintragen
Set oFS = CreateObject("Scripting.FileSystemObject")
For Each oDatei In oFS.GetFolder(sDateiPfad).Files
sWbName = oDatei.Name
If Left(LCase(oFS.GetExtensionName(sWbName)), 3) = "xls" Then
Workbooks.Open (sDateiPfad & sWbName)
Set Wsh = Workbooks(sWbName).Sheets("Übersicht")
With oMe.Cells(iZeile, iSpalte)
.Offset(0, 0).Value = Wsh.Range(sZelle1).Value
.Offset(0, 1).Value = Wsh.Range(sZelle2).Value
.Offset(0, 2).Value = Wsh.Range(sZelle3).Value
.Offset(0, 3).Value = Wsh.Range(sZelle4).Value
.Offset(0, 4).Value = Wsh.Range(sZelle5).Value
.Offset(0, 5).Value = Wsh.Range(sZelle6).Value
.Offset(0, 6).Value = Wsh.Range(sZelle7).Value
.Offset(0, 7).Value = Wsh.Range(sZelle8).Value
.Offset(0, 8).Value = Wsh.Range(sZelle9).Value
.Offset(0, 9).Value = Wsh.Range(sZelle10).Value
.Offset(0, 10).Value = Wsh.Range(sZelle11).Value
.Offset(0, 11).Value = Wsh.Range(sZelle12).Value
.Offset(0, 12).Value = Wsh.Range(sZelle13).Value
.Offset(0, 13).Value = Wsh.Range(sZelle14).Value
.Offset(0, 14).Value = Wsh.Range(sZelle15).Value
.Offset(0, 15).Value = Wsh.Range(sZelle16).Value
.Offset(0, 16).Value = Wsh.Range(sZelle17).Value
oMe.Hyperlinks.Add Anchor:=oMe.Cells(iZeile, iSpalte + 17), Address:=sDateiPfad & _
sWbName, TextToDisplay:="zum Auftrag"
End With
Workbooks(sWbName).Saved = True
Workbooks(sWbName).Close
iZeile = iZeile + 1
End If
Next
End Sub