VBS speciale datum Tracker (6 / 8 stap)

Stap 6: De Code

1) de toepassing Kladblok opent:
Klik op Start = > Klik op programma's = > Bureau-accessoires = > Kladblok Klik
Of
Klik op Start = > Klik op ## Run = > Type Kladblok in het invoer vak uitvoeren en klik op OK.
2) Kopieer de code hieronder de apostrof en sterretjes lijn plak deze in Kladblok.

' *********************************************
Dim aankondiging
Dim bericht
Dim fso
Dim objFile
Dim arrLines
Dim arrList
Dim bestandsnaam
Dim Hol(12)

Set fso = CreateObject("Scripting.FileSystemObject")

FileName = "c:\MySpecialDates.txt"

Const ForReading = 1
Const ForWriting = 2 ' zal over schrijven alles
Const ForAppending = 8 ' zal maken of bestand toevoegen

' deze code zal het gegevensbestand maken
Als (fso. FileExists(FileName)) = False Then
set objFile = FSO. OpenTextFile (FileName, ForAppending, True)

objFile.Close

Eind als

' Error Handling
On Error Resume Next

' Standaard Inputbox
Notice = "Mijn speciale datums - vandaag is" & WeekDayNAme(WeekDay(Date)) & "" & datum
Message = "Wat wilt u doen?" & vbcr & vbcr & _
"1 - view data voor deze maand" & vbcr & _
"2 - view data voor volgende maand" & vbcr & _
"3 - een datum en de naam aan uw lijst toevoegen" & vbCr & _
"4 - de naam en een datum uit uw lijst verwijderen" & vbcr & vbcr & _
"Het nummer van uw keuze."

' InputBox resultaten
Vraag = InputBox(message,Notice)
' Controleren op Null of leeg inputbox vervolgens annuleert
Als IsEmpty(Question) dan
WScript.quit()

ELSEIF Len(Question) = 0 THEN
WScript.quit()

ELSEIF vraag = 0 THEN
WScript.quit()

ANDERS
Selecteer geval vraag
Geval 1 Run(1)
Geval 2 Run(2)
Geval 3 Run(3)
Zaak 4 Run(4)
EINDE SELECTEREN

END IF

' Zaak verklaringen voor resultaat
Sub Run(var)
Instellen van WS = CreateObject("WScript.shell")

' Januari
' Dit controleert of huidige maand Dec om te beslissen welke datum vakantie te gebruiken
IF month(datum) = "12" then
Hol (0) = "01/01 /" & Right(DateSerial(Year(Date)+1,1,1),4) & "New Year's Day"
Hol(1) = "0" & DateSerial(Year(Date)+1,1,22) - Weekday(DateSerial(Year(Date)+1,1,22),3) & "MLK Day"
ANDERS
Hol (0) = "01/01 /" & Right(DateSerial(Year(Date),1,1),4) & "New Year's Day"
Hol(1) = "0" & DateSerial(Year(Date),1,22) - Weekday(DateSerial(Year(Date),1,22),3) & "MLK Day"
END IF

' Februari
Hol(2) = "02/14 /" & Year(Date) & "Valentine's Day"
Hol(3) = "0" & DateSerial(Year(Date),3,1) - Weekday(DateSerial(Year(Date),3,1),3) - 7 & "President's Day"

' Kan
Hol(4) = "0" & DateSerial(Year(Date),6,1) - Weekday(DateSerial(Year(Date),6,1),3) & "Memorial Day"

' Juli
Hol(5) = "07/04 /" & Year(Date) & "Independence Day"

' September
Hol(6) = "09/0" & Mid(DateSerial(Year(Date),9,8) - Weekday(DateSerial(Year(Date),9,8),3),3,1) & "/" & Year(Date) & "Labor Day"

' Oktober
Hol(7) = DateSerial(Year(Date),10,15) - Weekday(DateSerial(Year(Date),10,15),3) & "Columbus Day"

' November
Hol(8) = DateSerial(Year(Date),11,11) & "Veterans' Day"
Hol(9) = DateSerial(Year(Date),11,29) - Weekday(DateSerial(Year(Date),11,29),6) & "Thanksgiving Day"

' December
Hol(10) = DateSerial(Year(Date),12,25) & "Christmas Day"
Hol(11) = DateSerial(Year(Date),12,31) & "New Year's Eve"

Select Case var
Kast 1' lopende maand weergeven

Set objRegEx = CreateObject("VBScript.RegExp")
DateSearch = Right(String(2,"0") & month(datum), 2)
objRegEx.Pattern = "^" & DateSearch

Set objFile = fso. OpenTextFile (FileName, ForReading)
Set arrLines = CreateObject("System.Collections.ArrayList")

Do Until objFile.AtEndOfStream
strSearchString = objFile.ReadLine
Set colMatches = objRegEx.Execute(strSearchString)
IF colMatches.Count > 0 Then
Voor elke strMatch in colMatches
arrLines.Add(strSearchString)
Volgende

END IF

Loop

' Filter, Voeg & soort vakantie voor kalender maand
Voor i = 0 tot en met 11
Set colMatches = objRegEx.Execute(hol(i))
IF colMatches.Count > 0 Then
Voor elke strMatch in colMatches
arrLines.Add(hol(i))

arrLines.sort()

END IF

' Schrijven van alle speciale datums naar nieuw bestand, zodat de dag van de week kan worden toegevoegd
Dim TempFile
tempfile = "c:\Dates.txt"
set objFile = FSO. OpenTextFile (TempFile, ForAppending, True)
objFile.Close

' Lid van de matrix met regelinvoer
Dim strNewFile: strNewFile = Join (arrLines.ToArray, vbCrLf)
' Opnieuw het bestand openen voor lezen
Set objFile = fso. OpenTextFile (TempFile, ForWriting, False)
' Schrijf de nieuwe tekst
objFile.Write strNewFile
objFile.Close

' Open tempfile lezen, toevoegen van dag van de week dan tempfile verwijderen
Set objFile = fso. OpenTextFile (TempFile, ForReading)

msg1 = msg1 & strsearchstring & vbcrlf
Volgende

END IF

Loop
objFile.Close

' Agenda toevoegen aan bericht vak Bedankt lba maken
m = month(datum)
y = Year(Date)

w = weekdag (DateSerial (y, m, 1), w1) -1
l = dag (DateSerial (y, m + 1, 0)) + w

' Eerste lijn namen van dagen
Voor i = 1 tot en met 7
o = o & "" & WeekdayName (i, True) & ""
Volgende

' Datum van getallen
o = o & vbCrLf
Voor i = 1 tot en met l
d = ik - w
Als d < 1 dan
o = o & "--"
ELSE IF Len(d) = 1 then
o = o & "" & d & ""
ANDERS
o = o & "" & d & ""
END IF
END IF

Als (i-1) Mod 7 = 6 dan
o = o & vbCrLf
End If

Volgende
' Resultaten weergeven
MsgBox Msg1 & vbCrLf & o,,"speciale dagen van" & MonthName(Month(Date)) & "" & Year(Date)

' Tempfile verwijderen
fso. DeleteFile(Tempfile)

Zaak 2' Bekijk volgende maand
Set objRegEx = CreateObject("VBScript.RegExp")
DateSearch = Right(String(2,"0") & Month(DateAdd("M",1,date)), 2)
objRegEx.Pattern = "^" & DateSearch

Set objFile = fso. OpenTextFile (FileName, ForReading)
Set arrLines = CreateObject("System.Collections.ArrayList")

END IF

Loop

' Filter, Voeg & soort vakantie voor kalender maand
Voor i = 0 tot en met 11
Set colMatches = objRegEx.Execute(hol(i))
Als colMatches.Count > 0 Then
Voor elke strMatch in colMatches
arrLines.Add(hol(i))
arrLines.sort()

Eind als

' Schrijven van alle speciale datums naar nieuw bestand, zodat de dag van de week kan worden toegevoegd
Dim TempFile2
tempfile2 = "c:\Dates.txt"
set objFile = FSO. OpenTextFile (TempFile2, ForAppending, True)
objFile.Close

' Lid van de matrix met regelinvoer
Dim strNewFile2: strNewFile2 = Join (arrLines.ToArray, vbCrLf)
' Opnieuw het bestand openen voor lezen
Set objFile = fso. OpenTextFile (TempFile2, ForWriting, False)
' Schrijf de nieuwe tekst
objFile.Write strNewFile2
objFile.Close

' Open tempfile lezen, toevoegen van dag van de week dan tempfile verwijderen
Set objFile = fso. OpenTextFile (TempFile2, ForReading)

Do Until objFile.AtEndOfStream
strSearchString = objFile.ReadLine
Set colMatches = objRegEx.Execute(strSearchString)
Als colMatches.Count > 0 Then
Voor elke strMatch in colMatches
"Weekdag weergavenaam voor januari vakantie
Als jaar (linker (strSearchString, InStr (strSearchString,"")-1))=DateAdd("Y",1,Year(DATE)) dan
strSearchString = WeekDayName(WeekDay(DateAdd("yyyy",1,(mid(strSearchString,1,2) & "/" & Mid(strSearchString,4,2) & "/" & (Year(Date))) & ":" & strSearchString
' Huidige maand is 12, AnnvMonth 01 display weekdag en totale jaar voor volgend jaar
ElseIf maand (datum) = "12" en Left(strSearchString,2) = "01" And Mid(strSearchString,6,1) = "/" dan
strSearchString = WeekDayName(WeekDay(DateAdd("yyyy",1,(mid(strSearchString,1,2) & "/" & Mid(strSearchString,4,2) & "/" & (Year(Date))) & ":" & strSearchString & ":" & DateDiff("y",year(Left(strSearchString,10)),Year(Date)) + 1 & "Years"
' Huidige maand is 12, AnnvMonth 01 zonder AnnvYear dan diplay juiste weekdag naam
ElseIf maand (datum) = "12" en Left(strSearchString,2) = "01" And Mid(strSearchString,6,1) = "" dan
strSearchString = WeekDayName(WeekDay(DateAdd("yyyy",1,(mid(strSearchString,1,2) & "/" & Mid(strSearchString,4,2) & "/" & (Year(Date))) & ":" & strSearchString
' Huidige weekdag weergavenaam voor Annv datum zonder jaar of vakantie
Elseif jaar (linker (strSearchString, InStr (strSearchString,"")-1))=Year(DATE) dan
strSearchString = WeekDayName(WeekDay(mid(strSearchString,1,2) & "/" & Mid(strSearchString,4,2) & "/" & (year(Date())) & ":" & strSearchString
' De naam van de weekdag weergeven en berekenen van jaar
Anders
strSearchString = WeekDayName(WeekDay(mid(strSearchString,1,2) & "/" & Mid(strSearchString,4,2) & "/" & (year(Date())) & ":" & strSearchString & ":" & DateDiff("y",year(Left(strSearchString,10)),Year(Date)) & "Years"
END IF

msg1 = msg1 & strsearchstring & vbcrlf
Volgende

END IF
Loop
objFile.Close

' Agenda voor volgende maand toevoegen aan bericht vak Bedankt lba maken
m = Month(DateAdd("M",1,date))
"Als huidige maand Dec, wilt weergeven van de volgende maand- en jaarkalender
Als month(datum) = "12" then
Y =Year(DateAdd("YYYY",1,date))
ANDERS
Y = Year(Date)
END IF

w = weekdag (DateSerial (y, m, 1), w1) -1
l = dag (DateSerial (y, m + 1, 0)) + w

' Eerste lijn namen van dagen
Voor i = 1 tot en met 7
o = o & "" & WeekdayName (i, True) & ""
Volgende

' Datum
o = o & vbCrLf
Voor i = 1 tot en met l
d = ik - w
Als d < 1 dan
o = o & "--"
anders als Len(d) = 1 then
o = o & "" & d & ""
Anders
o = o & "" & d & ""
Eind als
End If

Als (i-1) Mod 7 = 6 dan
o = o & vbCrLf
End If

Volgende
' Resultaten weergeven
MsgBox Msg1 & vbCrLf & o,,"speciale dagen van" & MonthName(Month(DateAdd("M",1,date))) & "" & Y

' Tempfile verwijderen
fso. DeleteFile(Tempfile2)

Geval 3' toevoegen nieuwe datum
Notice = "Speciale datum toevoegen aan lijst"

Vraag = InputBox ("Enter datum en naam als" & vbCR & vbCR & "MM/DD/JJJJ naam ''''" & vbCR & "of" & vbCR & "MM/DD naam ''''", bericht)

' Controleren op Null of leeg inputbox vervolgens annuleert
Als IsEmpty(Question) dan
WScript.quit()

ELSEIF Len(Question) = 0 THEN
WScript.quit()

ANDERS
Als (fso. FileExists(FileName)) dan
set objFile = FSO. OpenTextFile (FileName, ForAppending, True)
objFile.WriteLine (vbCrLf & vraag)
Anders
set objFile = FSO. OpenTextFile (FileName, ForAppending, True)
objFile.WriteLine (vraag)

objFile.Close

Eind als

Set arrLines = CreateObject("System.Collections.ArrayList")
' Open het bestand
Set objFile = fso. OpenTextFile (FileName, ForReading, False)
' Thru b-l-lus en elke regel toevoegen aan de matrix
Do Until objFile.AtEndOfStream
strLine = Trim(objFile.ReadLine)
Als Len(strLine) > 0 Then
' Controleer of die array niet al het item
Als niet arrLines.Contains(strLine) dan arrLines.Add(strLine)
Eind als
Loop
objFile.Close
' Sorteren (oplopende) voor esthetica
arrLines.Sort()
' Lid van de matrix met vbCrLf (vervoer terug of voer)
Dim strNewFile1: strNewFile1 = Join (arrLines.ToArray, vbCrLf)
' Opnieuw het bestand openen voor lezen
Set objFile = fso. OpenTextFile (FileName, ForWriting, False)
' Schrijf de nieuwe tekst
objFile.Write strNewFile1
objFile.Close

MsgBox "Speciale datum en naam ingevoerd", bericht
END IF

Verwijder datum Case 4'
Set fso = CreateObject("Scripting.FileSystemObject")
Notice = "Welke maand?"
Vraag = InputBox ("Typ het nummer van de maand wilt u bekijken?" & vbCrLf & vbCrLf & "Enter als een nummer 1-12", merk)

Set objRegEx = CreateObject("VBScript.RegExp")
DateSearch = Right(String(2,"0") & vraag, 2)
objRegEx.Pattern = "^" & DateSearch

Set objFile = fso. OpenTextFile (FileName, ForReading)
' De datums in de lijst zoeken
Do Until objFile.AtEndOfStream
strSearchString = objFile.ReadLine
Set colMatches = objRegEx.Execute(strSearchString)
Als colMatches.Count > 0 Then
Voor elke strMatch in colMatches
Msg Msg = & "" & strSearchString & vbCrLf
Volgende

End If
Loop

objFile.Close

IF Len(Msg) = 0 THEN
MsgBox "Er zijn geen data in" & MonthName(Question) & "",,"speciale Days"
Anders
Notice = "Typt u de datum, naam of beide moet worden verwijderd."
Set objFile = fso. OpenTextFile (FileName, ForReading)

' Zet de matrix in in InputBox
Vraag = InputBox ("de datum en naam zijn Case Sensitive!" & vbCrLf & "specifieker hoe minder u typt het meer zal worden afgestemd en verwijderd." & vbCrLf & vbCrLf & Msg, aankondiging)

' Controleer of Inputbox leeg is, annuleren indien leeg
Als IsEmpty(Question) dan
WScript.quit()
ELSEIF Len(Question) = 0 THEN
WScript.quit()
ANDERS
' Betrokken Item verwijderen
Set objFile = fso. OpenTextFile (FileName, ForReading)

Do Until objFile.AtEndOfStream
strLine = objFile.ReadLine
Als InStr (strLine, vraag) = 0 Then
strNewContents = strNewContents & strLine & vbCrLf
End If
Loop
Eind als

objFile.Close

' Overige items naar het bestand te herschrijven
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFile = FSO. OpenTextFile (FileName, ForWriting)
objFile.Write strNewContents
objFile.Close
eind als
EINDE SELECTEREN
End Sub

' Error message handling
IF Err.Number <> 0 dan
MsgBox "u iets verkeerd ingevoerd. &Opnieuw. ", 0 + 16," Ooopps... "
WScript.quit()
END IF

Zie Stap

Gerelateerde Artikelen

Fotocel Sensor kledingstuk Fotocel sensor kledingstuk verbonden met sewable LED's / / gecodeerd met Arduino UNOStap 1: Maak het kledingstuk Ik gebr ...
DIY Quadcopter vanaf nul Vliegen is iets dat voor altijd deel van man's wens is geweest. We hebben willen nemen naar de hemel sinds we voor het e ...
Hoe te te nemen van een pijl In de knie voor "echte" ik was net bezig met het indienen van dit Instructable en dan...Er is zoiets als het nemen van een grap te ver, en vanda ...
Mechanisch potlood Launcher In dit instructable ik zal je leren een oude truc om een mechanisch potlood in een potlood launcher. Alles wat die u nod ...
Gemakkelijk "koude druk" ijskoffie het is zomertijd en mijn ochtend jones voor java vereist een wijziging van de temperatuur! Ik gebruikte om te werken op ...