Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

Mit VBScript einfache Arbeitszeit berechnen. Mit Mittagspause

Frage Entwicklung VB for Applications

Mitglied: JO-1983

JO-1983 (Level 1) - Jetzt verbinden

05.04.2013, aktualisiert 13:41 Uhr, 2334 Aufrufe, 13 Kommentare

Hallo zusammen,

ich weiß das ich mit CDate Funktionen und TimeValue das Ziel irgendwie erreich kann ... leider erreiche ich es aber nicht.

Ich habe folgendes Szenario welches ich, leider, aktuell nicht gelöst bekomme:

Ich möchte per Input Fenstern (klappt auch) meine Arbeitszeit berechnen.

--> szArbeitsBeginn = Beginn der Arbeit
--> szPauseAnfang = Beginn der Mittagspause
--> szPauseEnde = Ende der Mittagspause

Berechnet werden soll:

--> szPausenDauer = Pausenlänge

--> szHbisJetzt = wieviel Stunden ich bereits gearbeitet habe

--> szSollerreicht = um wieviel Uhr ich mein Arbeitssoll von 8h erreicht habe


in meinem bisherigen Skript schaffe ich es auch in etwa die Werte zu erreichen allerdings funktioniert meine Umrechnung von , auf Uhrzeit nicht und ich bekomm die Formel für die "Um wieveil Uhr sind meine 8h erreicht" nicht hin.


So - jetzt paste ich mein bisheriges Skript mal hier rein und hoffe das mir einer helfen kann.




Dim szSollH, szArbeitsBeginn, szPauseAnfang, szPauseEnde, szPausenDauer, szHbisJetzt, szSollerreicht
Dim szFinalMessage
szSollH = "8:00:00"
szArbeitsBeginn = InputBox("Eingestempelt um ", "Arbeitszeit", "08:00")
if szArbeitsBeginn = "" then
else
szPauseAnfang = TimeValue(InputBox("Pause Anfang", "Arbeitszeit", "11:15"))
szPauseEnde = TimeValue(InputBox("Pause Ende", "Arbeitszeit", "13:00"))
' Rechne
' Pausenlänge
szPausenDauer = DateDiff("n", szPauseAnfang, szPauseEnde) / 60
szFinalMessage = "Mittagspause: " & vbTab & szPausenDauer & "h" & vbcrlf
' Bis jetzt gearbeitet
szHbisJetzt = DateDiff("n", TimeValue(szArbeitsBeginn), TimeValue(Now())) / 60
szFinalMessage = szFinalMessage & "Arbeitszeit bisher: " & vbTab & szHbisJetzt & "h" & vbcrlf
' Wann ist Soll erreicht
'szSollerreicht = TimeValue(szSollH) + TimeValue(szArbeitsBeginn) + szPausenDauer
szSollerreicht = TimeValue(szSollH) + TimeValue(szArbeitsBeginn) + szPausenDauer
szFinalMessage = szFinalMessage & "Soll erreicht um: " & vbTab & TimeValue(szSollerreicht) & "Uhr" & vbcrlf
' Ausgabe
wscript.echo szFinalMessage
end if

Das ganze sieht in meinem Editor etwas schöner aus:

da5c90371548ce435cf63685b312007b - Klicke auf das Bild, um es zu vergrößern
Mitglied: bastla
05.04.2013, aktualisiert um 18:52 Uhr
Hallo JO-1983 und willkommen im Forum!

Versuch es als Anhaltpunkt einmal mit folgenden Zeilen 13 und 14:
01.
szPausenDauer = szPauseEnde - szPauseAnfang 
02.
szFinalMessage = "Mittagspause: " & vbTab & FormatDateTime(szPausenDauer, 4) & " h" & vbcrlf
- da Du in den Variablen ja bereits Zeitwerte hast, ist es nicht sinnvoll, auf Minuten (Stunden) zu konvertieren.

Grüße
bastla

P.S.: So schön wie in Deinem Editor wird Code hier zwar nicht dargestellt, aber mit Verwendung von <code>- / </code>-Tags sieht er zumindest etwas besser aus (und ist aufgrund der Zeilennummern auch leichter zu referenzieren) ...
Bitte warten ..
Mitglied: 76109
05.04.2013, aktualisiert um 20:06 Uhr
Hallo JO-1983!

Der Vollständigkeit halber

Um den Variablen den Datentyp Zeit zuzuweisen, verwendest Du entweder die Funktion 'TimeValue' oder 'CDate' Intern haben Datums- und Zeitangaben den Datentyp Double, wobei das Datum >= 1 und Zeit < 1 (1 sekunde = 1/86400). D.h., dass Du mit den Werten ganz normal rechnen kannst, wenn der Zeit-Text in das entsprechende Zahlenformat umgewandelt wird.

Mit DateDiff berechnest Du ja nur Intervalle in Stunden (h), Minuten (n) oder Sekunden (s)

01.
dArbeitszeit = TimeValue("8:00") 
02.
dArbeitsBegin = TimeValue("8:00")   ' 
03.
dPausenBegin = TimeValue("11:15") 
04.
dPausenEnde = TimeValue("13:00") 
05.
     
06.
dArbeitsEnde = CDate(dArbeitsBegin + dArbeitszeit + dPausenEnde - dPausenBegin) 
07.
     
08.
MsgBox dArbeitsEnde
Gruß Dieter
Bitte warten ..
Mitglied: bastla
05.04.2013, aktualisiert um 19:35 Uhr
@ Dieter
Danke für die Ergänzug

Magst Du noch
Zeit <= 0
(und auch
Datum > 0
) korrigieren?

Grüße
bastla
Bitte warten ..
Mitglied: 76109
05.04.2013, aktualisiert um 20:07 Uhr
Hallo bastla!

Sorry, stehe gerade auf der Leitung?

Gruß Dieter

[edit] ist mir doch noch was dazu eingefallen (korrigiert...?) [/edit]
Bitte warten ..
Mitglied: bastla
05.04.2013, aktualisiert um 20:15 Uhr
Hallo Dieter!

Yep.

Grüße
bastla
Bitte warten ..
Mitglied: JO-1983
05.04.2013 um 23:08 Uhr
Hallo und vielen Dank für die schnelle Reaktion von euch!

... auch Danke für die "Willkommen Grüße"

Ich hatte es heute Abend tatsächlich noch lösen können.
Am Montag werde ich den Code posten da ich den nicht hier habe.

Kurz: ich hab tatsächlich dann mit den Minuten weiter gerechnet und bzgl. der Sollstunden noch eine Lösung gefunden.

Also am Montag mehr ...
Bitte warten ..
Mitglied: JO-1983
08.04.2013 um 08:13 Uhr
Guten Morgen zusammen,

die Lösung ist, wie von euch schon als Tipp gegeben, hier in Minuten zu rechnen.

Der Code sollte selbsterklärend sein.

Vielen Dank für euren schnellen Support

01.
 '*************************************** 
02.
' Arbeitszeit 
03.
'*************************************** 
04.
Sub Sub_Arbeitszeit() 
05.
Dim szSollH, szSollH2, szArbeitsBeginn, szPauseAnfang, szPauseEnde, szPausenDauerMinuten 
06.
Dim szArbeitsZeitMinuten, szSollerreicht, szFinalMessage, szEchteArbeitszeit 
07.
szSollH = "7:30" 
08.
szArbeitsBeginn = InputBox(vbcrlf & vbcrlf & "Eingestempelt um ", "Arbeitszeit", "07:17") 
09.
if szArbeitsBeginn = "" OR len(szArbeitsBeginn) < 3 then 
10.
else 
11.
	szPauseAnfang = InputBox(vbcrlf & vbcrlf & "Pause Anfang", "Arbeitszeit", "11:48") 
12.
	if szPauseAnfang = "0" then 
13.
		szPauseAnfang = TimeValue("00:00") 
14.
		szPauseEnde = "00:00" 
15.
	else 
16.
		szPauseEnde = TimeValue(InputBox(vbcrlf & vbcrlf & "Pause Ende", "Arbeitszeit", "12:44")) 
17.
	end if 
18.
	' **************** Rechne 
19.
	' 	Pausenlänge 
20.
	szPausenDauerMinuten = DateDiff("n", szPauseAnfang, szPauseEnde) 
21.
	szFinalMessage = "Mittagspause: " & vbTab & szPausenDauerMinuten / 60 & " h" & vbcrlf 
22.
	' 	Bis jetzt gearbeitet 
23.
	szArbeitsZeitMinuten = DateDiff("n", TimeValue(szArbeitsBeginn), TimeValue(Now())) - szPausenDauerMinuten			 
24.
	szEchteArbeitszeit = szArbeitsZeitMinuten / 60 
25.
	szFinalMessage = szFinalMessage & "Arbeitszeit bisher: " & vbTab & szEchteArbeitszeit & "h" & vbcrlf 
26.
	'	Wann ist Soll erreicht 
27.
	szSollH2 = DateAdd("n", szPausenDauerMinuten, szSollH) 
28.
	szSollerreicht = TimeValue(szArbeitsBeginn) + TimeValue(DateAdd("n", szPausenDauerMinuten, szSollH)) 
29.
	szFinalMessage = szFinalMessage & "Soll erreicht: " & vbTab & szSollerreicht & " Uhr" & vbcrlf 
30.
	' **************** Rechne 
31.
	' Ausgabe 
32.
	wscript.echo szFinalMessage 
33.
end if 
34.
End Sub
Bitte warten ..
Mitglied: JO-1983
08.04.2013 um 13:59 Uhr
Hallo,

jetzt muss ich doch noch Mal was fragen:

wie mache ich aus einer 2,75 eine Ausgabe mit 02:45h

???
Bitte warten ..
Mitglied: bastla
08.04.2013 um 15:34 Uhr
Hallo JO-1983!
die Lösung ist, wie von euch schon als Tipp gegeben, hier in Minuten zu rechnen.
Der Tipp war zwar nicht, in Minuten zu rechnen, sondern einfach direkt die Zeitwerte zu addieren / subtrahieren, aber wenn's auch so passt ...
wie mache ich aus einer 2,75 eine Ausgabe mit 02:45h
Schau Dir (nochmals) die Zeile 2 meines Ansatzes ganz oben an ...

Grüße
bastla
Bitte warten ..
Mitglied: JO-1983
08.04.2013, aktualisiert um 20:45 Uhr
Hallo bastla,

danke und jetzt hab ich es tatsächlich kapiert.

Mein Skript hab ich jetzt komplett nach deiner Idee umgeschrieben!

So ein quatsch von mir alles in Minuten etc.. zu rechnen. Mit CDate lässt sich ja (wenn die Werte als TimeValue deklariert sind) richtig gut rechnen.

Jetzt finde ich mein Skript richtig top - auch das Ergebnis sieht richtig ordentlich aus.

Vielen Dank an Dich !

01.
 
02.
 '*************************************** 
03.
' Arbeitszeit 
04.
'*************************************** 
05.
'Sub Sub_Arbeitszeit() 
06.
Dim dSollH, dArbeitsBeginn, dPauseEnde, dPausenlaenge, dAktuelleArbeitszeit, szFinalMessage, dSollerreicht 
07.
dSollH = TimeValue("7:30") 
08.
dSollHFr = TimeValue("6:00") 
09.
dArbeitsBeginn = InputBox(vbcrlf & vbcrlf & "Eingestempelt um ", "Arbeitszeit", "") 
10.
if dArbeitsBeginn = "" OR len(dArbeitsBeginn) < 3 then 
11.
else 
12.
	' prüfen ob : mit angegeben wurde 
13.
	if instr(dArbeitsBeginn,":") = 0 then 
14.
		dArbeitsBeginn = left(dArbeitsBeginn,len(dArbeitsBeginn)-2) & ":" & right(dArbeitsBeginn,2) 
15.
	end if 
16.
	dArbeitsBeginn = TimeValue(dArbeitsBeginn) 
17.
	dPauseAnfang = InputBox(vbcrlf & vbcrlf & "Pause Anfang", "Arbeitszeit", "0") 
18.
	if dPauseAnfang = "" OR len(dPauseAnfang) < 3 then 
19.
		dPauseAnfang = TimeValue("00:00") 
20.
	else 
21.
		' prüfen ob : mit angegeben wurde 
22.
		if instr(dPauseAnfang,":") = 0 then 
23.
			dPauseAnfang = left(dPauseAnfang,len(dPauseAnfang)-2) & ":" & right(dPauseAnfang,2) 
24.
		end if 
25.
		dPauseAnfang = TimeValue(dPauseAnfang) 
26.
		dPauseEnde = InputBox(vbcrlf & vbcrlf & "Pause Ende", "Arbeitszeit", "") 
27.
		' prüfen ob : mit angegeben wurde 
28.
		if instr(dPauseEnde,":") = 0 then 
29.
			dPauseEnde = left(dPauseEnde,len(dPauseEnde)-2) & ":" & right(dPauseEnde,2) 
30.
		end if 
31.
		dPauseEnde = TimeValue(dPauseEnde) 
32.
	end if 
33.
	' **************** Rechne 
34.
	' 	Pausenlänge 
35.
	dPausenlaenge = CDate(dPauseEnde - dPauseAnfang) 
36.
	szFinalMessage = "Mittagspause: " & vbTab & FormatDateTime(dPausenlaenge, 4) & "h" & vbcrlf 
37.
	' 	Bis jetzt gearbeitet 
38.
	dAktuelleArbeitszeit = CDate((TimeValue(Now()) - dArbeitsBeginn) - dPausenlaenge) 
39.
	szFinalMessage = szFinalMessage & "Arbeitszeit bisher: " & vbTab & FormatDateTime(dAktuelleArbeitszeit, 4) & "h" & vbcrlf 
40.
	'	Wann ist Soll erreicht 
41.
	dSollerreicht = CDate(dArbeitsBeginn + dSollH + dPausenlaenge) 
42.
	szFinalMessage = szFinalMessage & "Soll erreicht: " & vbTab & FormatDateTime(dSollerreicht, 4) & "Uhr" & vbcrlf 
43.
	'   bis dahin sind es noch bzw. drüber  
44.
	if TimeValue(Now()) > dSollerreicht then 
45.
		dZeitbisSoll = CDate(TimeValue(Now()) - dSollerreicht)	 
46.
		szFinalMessage = szFinalMessage & "schon drüber mit: " & vbTab & FormatDateTime(dZeitbisSoll, 4) & "h" & vbcrlf 
47.
	else 
48.
		dZeitbisSoll = CDate(TimeValue(Now()) - dSollerreicht) 
49.
		szFinalMessage = szFinalMessage & "das dauert noch: " & vbTab & FormatDateTime(dZeitbisSoll, 4) & "h" & vbcrlf 
50.
	end if 
51.
	'   ist heute Freitag? 
52.
	If weekday(Date()) = vbFriday then 
53.
		dSollerreicht = CDate(dArbeitsBeginn + dSollHFr + dPausenlaenge) 
54.
		szFinalMessage = szFinalMessage & vbcrlf & "heute Ende um: " & vbTab & FormatDateTime(dSollerreicht, 4) & "Uhr" & vbcrlf 
55.
	end if 
56.
	' **************** Rechne 
57.
	' Ausgabe 
58.
	MsgBox szFinalMessage, 27,"Arbeitszeit" 
59.
end if 
60.
'End Sub 
61.
 
Bitte warten ..
Mitglied: bastla
08.04.2013, aktualisiert um 21:21 Uhr
Hallo JO-1983!

Ein Tipp: Wenn Du den gleichen Programmteil dreimal verwendest, bietet es sich eigentlich schon an, ein "Sub" oder, wie hier, eine "Function" daraus zu machen - Du könntest daher die Zeilen 12 - 16 durch
dArbeitsBeginn = GetTime(dArbeitsBeginn)
21 - 25 durch
dPauseAnfang = GetTime(dPauseAnfang)
und 27 - 31 durch
dPauseEnde = GetTime(dPauseEnde)
ersetzen und am Ende des Scripts
01.
Function GetTime(dZeit) ' prüfen ob : mit angegeben wurde 
02.
If InStr(dZeit, ":") = 0 Then dZeit = Left(dZeit, Len(dZeit) - 2) & ":" & Right(dZeit, 2) 
03.
GetTime = TimeValue(dZeit) 
04.
End Function
hinzufügen.
Was jedenfalls noch fehlt ist als erste Zeile
Option Explicit
- so machen nämlich die Variablendeklarationen auch Sinn, da Du dann nicht nur bemerkst, dass zB "dSollHFr" nicht deklariert wurde, sondern auch auf Schreibfehler in Variablennamen aufmerksam wirst (weil die falsch geschriebene Variable als "undefined" erkannt wird) ...

Grüße
bastla
Bitte warten ..
Mitglied: JO-1983
08.04.2013, aktualisiert um 21:51 Uhr
Hallo bastla,

auch dafür wieder ein dickes Danke !!!
das bastel ich morgen zusammen.
Top Idee mit der Function - macht das ganze schick - setz ich so morgen auch um!

Gruß
JO-1983
Bitte warten ..
Mitglied: JO-1983
29.05.2013 um 14:49 Uhr
Ich möchte gerne mein aktuelles Skript hier posten.
Es kann mittlerweile auch Outlook Einträge erstellen. Das erinnert dann an das erreichen der Arbeitszeit

01.
-  
02.
 
03.
 
04.
' ******************************************************************************************* 
05.
' Arbeitszeitrechner 
06.
'  
07.
' erstellt: 10.04.2013 TSi  
08.
' geändert: 17.05.2013 TSi - Freitagsanzeige angepasst | vbFriday 
09.
' geändert: 29.05.2013 TSi/JB - Outlook Termin erstellen | Sub_OutlookTermin 
10.
' geändert:  
11.
' geändert:  
12.
' ******************************************************************************************* 
13.
  
14.
Option Explicit 
15.
' Registry Handling 
16.
Const cHKCU = &h80000001 
17.
Const cHKLM = &h80000002 
18.
Const cHKCR = &h80000000 
19.
' File Handling 
20.
Const cForReading = 1 
21.
Const cForWriting = 2 
22.
Const cForAppending = 8 
23.
Const cTristateUseDefault = -2 
24.
Const cTristateTrue = -1 
25.
Const cTristateFalse = 0 
26.
' DialogBox Handling 
27.
Const cICON_STOP = 16 ' display the ERROR/STOP icon. 
28.
Const cICON_QUESTION = 32 ' display the '?' icon 
29.
Const cICON_WARN = 48 ' display a '!' icon. 
30.
Const cICON_INFO =  64 ' displays "info" icon. 
31.
Const cBUTTON_OK = 0 ' OK button only 
32.
Const cBUTTON_CANCEL = 1 ' OK and Cancel buttons 
33.
Const cBUTTON_ABORTRETRYIGNORE = 2 ' Abort, Retry, and Ignore buttons 
34.
Const cBUTTON_YESNOCANCEL = 3 ' Yes, No, and Cancel buttons 
35.
Const cBUTTON_YESNO = 4 ' Yes and No buttons 
36.
Const cBUTTON_RETRYCANCEL = 5 ' Retry and Cancel buttons 
37.
Const cDEFBUTTON1 = 0 ' First button is default 
38.
Const cDEFBUTTON2 = 256 ' Second button is default 
39.
Const cDEFBUTTON3 = 512 ' Third button is default 
40.
Const cIDOK = 1 ' OK button clicked 
41.
Const cIDCANCEL = 2 ' Cancel button clicked 
42.
Const cIDABORT = 3 ' Abort button clicked 
43.
Const cIDRETRY = 4 ' Retry button clicked 
44.
Const cIDIGNORE = 5 ' Ignore button clicked 
45.
Const cIDYES = 6 ' Yes button clicked 
46.
Const cIDNO = 7 ' No button clicked 
47.
' ADS Handling 
48.
Const ADS_PROPERTY_CLEAR = 1 
49.
Const ADS_SCOPE_SUBTREE = 2 
50.
 
51.
' Objekte anlegen 
52.
Dim objShell, objFileSystem, objNetwork, objReg, szSystemroot 
53.
  
54.
Set objShell = CreateObject("WScript.Shell") 
55.
Set objFileSystem = CreateObject("Scripting.FileSystemObject") 
56.
Set objNetwork = CreateObject("WScript.Network") 
57.
Set objReg = GetObject("winmgmts:\\.\root\Default:StdRegProv") 
58.
	 
59.
	' Start 
60.
	Call Sub_Arbeitszeit() 
61.
	 
62.
' Objekte löschen 
63.
WScript.DisconnectObject(objShell) 
64.
WScript.DisconnectObject(objFileSystem) 
65.
WScript.DisconnectObject(objNetwork) 
66.
WScript.DisconnectObject(objReg) 
67.
  
68.
' Wscript.Sleep(1000) 
69.
WScript.Quit	 
70.
	 
71.
'*************************************** 
72.
' Arbeitszeit 
73.
'*************************************** 
74.
Sub Sub_Arbeitszeit() 
75.
	Dim dSollH, dSollHFr, dArbeitsBeginn, dPauseEnde, dPauseAnfang, dPausenlaenge, dAktuelleArbeitszeit, szFinalMessage, dSollerreicht, dZeitbisSoll, szUserChoice 
76.
	dSollH = TimeValue("7:30") 
77.
	dSollHFr = TimeValue("6:00") 
78.
	dArbeitsBeginn = InputBox(vbcrlf & vbcrlf & "Eingestempelt um ", "Arbeitszeit", "") 
79.
	if dArbeitsBeginn = "" OR len(dArbeitsBeginn) < 3 then 
80.
	else 
81.
		dArbeitsBeginn = GetTime(dArbeitsBeginn) ' prüfen ob : drin ist 
82.
		dPauseAnfang = InputBox(vbcrlf & vbcrlf & "Pause Anfang", "Arbeitszeit", "0") 
83.
		if dPauseAnfang = "" OR len(dPauseAnfang) < 3 then 
84.
			dPauseAnfang = TimeValue("00:00") 
85.
		else 
86.
			dPauseAnfang = GetTime(dPauseAnfang) ' prüfen ob : mit angegeben wurde 
87.
			dPauseEnde = InputBox(vbcrlf & vbcrlf & "Pause Ende", "Arbeitszeit", "") 
88.
			dPauseEnde = GetTime(dPauseEnde) ' prüfen ob : mit angegeben wurde 
89.
		end if 
90.
		' **************** Rechne **************** 
91.
		dPausenlaenge = CDate(dPauseEnde - dPauseAnfang)' Pausenlänge 
92.
		szFinalMessage = "Mittagspause: " & vbTab & FormatDateTime(dPausenlaenge, 4) & "h" & vbcrlf 
93.
		dAktuelleArbeitszeit = CDate((TimeValue(Now()) - dArbeitsBeginn) - dPausenlaenge)' Bis jetzt gearbeitet 
94.
		szFinalMessage = szFinalMessage & "Arbeitszeit bisher: " & vbTab & FormatDateTime(dAktuelleArbeitszeit, 4) & "h" & vbcrlf 
95.
		dSollerreicht = CDate(dArbeitsBeginn + dSollH + dPausenlaenge)' Wann ist Soll erreicht 
96.
		szFinalMessage = szFinalMessage & "Soll erreicht: " & vbTab & FormatDateTime(dSollerreicht, 4) & "Uhr" & vbcrlf 
97.
		if TimeValue(Now()) > dSollerreicht then' bis dahin sind es noch bzw. drüber  
98.
			dZeitbisSoll = CDate(TimeValue(Now()) - dSollerreicht)     
99.
			szFinalMessage = szFinalMessage & "schon drüber mit: " & vbTab & FormatDateTime(dZeitbisSoll, 4) & "h" & vbcrlf 
100.
		else 
101.
			dZeitbisSoll = CDate(TimeValue(Now()) - dSollerreicht) 
102.
			szFinalMessage = szFinalMessage & "das dauert noch: " & vbTab & FormatDateTime(dZeitbisSoll, 4) & "h" & vbcrlf 
103.
		end if 
104.
		If weekday(Date()) = vbFriday then' ist heute Freitag? 
105.
			dSollerreicht = CDate(dArbeitsBeginn + dSollHFr + dPausenlaenge) 
106.
			szFinalMessage = szFinalMessage & vbcrlf & "heute Ende um: " & vbTab & FormatDateTime(dSollerreicht, 4) & "Uhr" & vbcrlf 
107.
			dZeitbisSoll = CDate(TimeValue(Now()) - dSollerreicht) 
108.
			szFinalMessage = szFinalMessage & "das dauert noch: " & vbTab & FormatDateTime(dZeitbisSoll, 4) & "h" & vbcrlf 
109.
		end if 
110.
		' **************** Finale Ausgabe **************** 
111.
		'MsgBox szFinalMessage, cICON_INFO,"Arbeitszeit" ' Ausgabe 
112.
		'PCListe = InputBox("Body", "Arbeitszeit" ,"TXT") 
113.
		szUserChoice = MsgBox(szFinalMessage & vbcrlf & "Soll erreicht Zeit in Outlook eintragen?", cICON_INFO + cBUTTON_YESNO + cDEFBUTTON2,"Arbeitszeit") 
114.
		' **************** Outlook Termin setzen *************** 
115.
		if szUserChoice = cIDYES then 
116.
			Call Sub_OutlookTermin(dSollerreicht) 
117.
		end if 
118.
	end if 
119.
End Sub 
120.
 
121.
'*************************************** 
122.
' Outlook Termin setzen 
123.
'*************************************** 
124.
Sub Sub_OutlookTermin(szUhrzeit) 
125.
	Dim objOutlook, apptOutApp, objNamespace, objFolder, colItems, objItem, strFilter, colFilteredItems 
126.
	 
127.
	Set objOutlook = CreateObject("Outlook.Application") 
128.
	Set objNamespace = objOutlook.GetNamespace("MAPI") 
129.
	Set objFolder = objNamespace.GetDefaultFolder(9) 
130.
	' alten Termin suchen und löschen 
131.
	Set colItems = objFolder.Items 
132.
	strFilter = "[Start] >= '" & date()-5 & "' AND [Start] <= '" & date()+1 & "'"   ' damit löscht er den Termin der letzten 5 Tage!  
133.
	Set colFilteredItems = colItems.Restrict(strFilter) 
134.
	For Each objItem in colFilteredItems 
135.
		if instr(objItem.Subject,"done") AND instr(objItem.Body,"##$$§&&%%") then 
136.
			objItem.Delete 
137.
		end if 
138.
	Next 
139.
	' neuen Termin heute erstellen 
140.
	Set apptOutApp = objOutlook.CreateItem(1)  
141.
	With apptOutApp  
142.
		'.Start = date() & " " & Hour(Now()) & ":" & Minute(Now()) 
143.
		.Start = date() & " " & szUhrzeit 
144.
		.Subject = "done" 
145.
		.Body = "##$$§&&%%" 
146.
		.Location = "" 
147.
		.Duration = "0" 
148.
		.ReminderMinutesBeforeStart = 0 
149.
		.ReminderPlaySound = False 
150.
		.ReminderSet = True 
151.
		.Sensitivity = 2 
152.
		.Save 
153.
	End With 
154.
 
155.
	Set apptOutApp = Nothing 
156.
	Set objOutlook = Nothing 
157.
	Set objFolder = Nothing 
158.
	Set objNamespace = Nothing 
159.
	' http://msdn.microsoft.com/en-us/library/office/aa210899(v=office.11).aspx 
160.
	' http://blogs.technet.com/b/heyscriptingguy/archive/2008/02/21/how-can-i-set-a-reminder-on-all-my-outlook-appointments.aspx?Redirected=true 
161.
End Sub 
162.
 
163.
'*************************************** 
164.
' Funktion  
165.
'    fügt ein : in die Zeit ein 
166.
'***************************************	 
167.
Function GetTime(dZeit) ' prüfen ob : mit angegeben wurde 
168.
	If InStr(dZeit, ":") = 0 Then dZeit = Left(dZeit, Len(dZeit) - 2) & ":" & Right(dZeit, 2) 
169.
	GetTime = TimeValue(dZeit) 
170.
End Function 
171.
 
172.
 
173.
 
174.
 
175.
 
176.
 
177.
 
Bitte warten ..
Neuester Wissensbeitrag
CPU, RAM, Mainboards

Angetestet: PC Engines APU 3a2 im Rack-Gehäuse

(1)

Erfahrungsbericht von ashnod zum Thema CPU, RAM, Mainboards ...

Ähnliche Inhalte
Netzwerke
HTTP Overhead Berechnen und Protokolstack

Frage von karlosss zum Thema Netzwerke ...

Entwicklung
gelöst Get ip from external txt file and use in vbscript (5)

Frage von thankusomuch zum Thema Entwicklung ...

Festplatten, SSD, Raid
Speicher der nächsten Jahre berechnen (10)

Frage von Ravers zum Thema Festplatten, SSD, Raid ...

VB for Applications
gelöst Vbscript bestimmte Zeile ungeachtet der Nummerierung löschen (4)

Frage von aletri zum Thema VB for Applications ...

Heiß diskutierte Inhalte
DSL, VDSL
DSL-Signal bewerten (13)

Frage von SarekHL zum Thema DSL, VDSL ...

Switche und Hubs
Trunk für 2xCisco Switch. Wo liegt der Fehler? (9)

Frage von JayyyH zum Thema Switche und Hubs ...

Windows Server
Mailserver auf Windows Server 2012 (9)

Frage von StefanT81 zum Thema Windows Server ...

Backup
Clients als Server missbrauchen? (9)

Frage von 1410640014 zum Thema Backup ...