VBS fecha especial Tracker (6 / 8 paso)

Paso 6: El código

1) abrir la aplicación Bloc de notas:
Haga clic en Inicio = > haga clic en programas = > accesorios , haga clic en = > haga clic en Bloc de notas
O
Haga clic en Inicio = > haga clic en Ejecutar = > tipo Bloc de notas en el cuadro Ejecutar y haga clic en Aceptar.
2) copie el código abajo el apóstrofe y asteriscos línea a continuación, péguelo en Bloc de notas.

' *********************************************
Dim aviso
Dim mensaje
Dim fso
ObjFile DIM
Dim arrLines
Dim arrList
Dim archivo
Dim Hol(12)

Set fso = CreateObject("Scripting.FileSystemObject")

Nombre de archivo = "c:\MySpecialDates.txt"

Const ForReading = 1
ForWriting const = 2 ' a sobre escribir todo
ForAppending const = 8 ' se crear o anexar archivo

' este código creará el archivo de datos
Si (FOE. FileExists(FileName)) = False Then
Set objFile = FSO. OpenTextFile (nombre de archivo, ForAppending, True)

objFile.Close

Terminar si

' Control de errores
Error volver siguiente

' Inputbox estándar
Aviso = "Fechas especiales mi - hoy es" & WeekDayNAme(WeekDay(Date)) & "" & fecha
Mensaje = "¿qué desea hacer?" & vbcr & vbcr & _
"1 - ver fechas para este mes" & vbcr & _
"2 - ver fechas para el próximo mes" & vbcr & _
"3 - Añadir una fecha y un nombre a su lista de" & vbCr & _
"4 - quitar la fecha y el nombre de la lista" & vbcr & vbcr & _
"Introduzca el número de su elección."

' InputBox resultados
Pregunta = InputBox(message,Notice)
' Comprobar Null o vacía inputbox luego cancela
IF IsEmpty(Question) entonces
WScript.quit()

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

Pregunta de ELSEIF = 0 entonces
WScript.quit()

OTRA COSA
Seleccione pregunta de caso
Caso 1 Run(1)
Caso 2 Run(2)
Caso 3 Run(3)
Caso 4 Run(4)
FINAL SELECCIONE

END IF

' Declaraciones del caso para el resultado
Sub Run(var)
Set WS = CreateObject("WScript.shell")

' Enero
' Comprueba si el mes actual es diciembre para decidir que fecha de vacaciones para usar
IF Month(date) = "12" entonces
Hol (0) = "01/01 /" & Right(DateSerial(Year(Date)+1,1,1),4) & "Día de año nuevo"
Hol(1) = "0" & DateSerial(Year(Date)+1,1,22) - Weekday(DateSerial(Year(Date)+1,1,22),3) "Día de Martin Luther King"
OTRA COSA
Hol (0) = "01/01 /" & Right(DateSerial(Year(Date),1,1),4) & "Día de año nuevo"
Hol(1) = "0" & DateSerial(Year(Date),1,22) - Weekday(DateSerial(Year(Date),1,22),3) "Día de Martin Luther King"
END IF

' Febrero
Hol(2) = "02/14 /" & Year(Date) & "Día de los enamorados"
Hol(3) = "0" & DateSerial(Year(Date),3,1) - Weekday(DateSerial(Year(Date),3,1),3) - 7 & "día del Presidente"

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

' Julio
Hol(5) = "07/04 /" & Year(Date) & "Día de la independencia"

' Septiembre
Hol(6) = "09/0" & Mid(DateSerial(Year(Date),9,8) - Weekday(DateSerial(Year(Date),9,8),3),3,1) & "/" & Year(Date) & "Día del trabajo"

' Octubre
Hol(7) = DateSerial(Year(Date),10,15) - Weekday(DateSerial(Year(Date),10,15),3) y "Día de Colón"

' Noviembre
Hol(8) = DateSerial(Year(Date),11,11) & "Día de los veteranos"
Hol(9) = DateSerial(Year(Date),11,29) - Weekday(DateSerial(Year(Date),11,29),6) & "día de acción de gracias"

' Diciembre
Hol(10) = DateSerial(Year(Date),12,25) & "Día de la Navidad"
Hol(11) = DateSerial(Year(Date),12,31) & "Vísperas de año nuevo"

Seleccione caso var
Caso 1' ve mes actual

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

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

Hasta objFile.AtEndOfStream
strSearchString = objFile.ReadLine
Set colMatches = objRegEx.Execute(strSearchString)
IF colMatches.Count > 0 entonces
Para cada strMatch en colMatches
arrLines.Add(strSearchString)
Siguiente

END IF

Lazo

' Filtro, añadir y ordenar vacaciones calendario mes
Para i = 0 a 11
Set colMatches = objRegEx.Execute(hol(i))
IF colMatches.Count > 0 entonces
Para cada strMatch en colMatches
arrLines.Add(hol(i))

arrLines.sort()

END IF

' Escribir fechas especiales todo a nuevo archivo para los días de semana se pueden agregar
Dim
= "c:\Dates.txt"
Set objFile = FSO. OpenTextFile (TempFile, ForAppending, True)
objFile.Close

' Únete a la matriz con avance de línea
StrNewFile DIM: strNewFile = Join (arrLines.ToArray, vbCrLf)
' Volver a abrir el archivo para lectura
Set objFile = fso. OpenTextFile (TempFile, ForWriting, False)
' Escribir el nuevo texto
objFile.Write strNewFile
objFile.Close

' Open leer, añadir los días de semana y eliminar
Set objFile = fso. OpenTextFile (TempFile, ForReading)

MSG1 = msg1 & strsearchstring & vbcrlf
Siguiente

END IF

Lazo
objFile.Close

' Crear calendario para agregar al cuadro de mensaje gracias lba
m = Month(date)
y = Year(Date)

w = días laborables (DateSerial (y, m, 1), w1) -1
l = Day (DateSerial (y, m + 1, 0)) + w

' Nombres de los días de la primera línea
Para i = 1 a 7
o = o & "" & WeekdayName (i, True) & ""
Siguiente

' Fecha números
o = o & vbCrLf
Para i = 1 a l
d = i - c
IF d < 1 entonces
o = o & "--"
ELSE IF Len(d) = 1 then
o = o & "" & d & ""
OTRA COSA
o = o & "" & d & ""
END IF
END IF

Si (i-1) Mod 7 = 6 entonces
o = o & vbCrLf
End If

Siguiente
' Mostrar los resultados
MsgBox Msg1 & vbCrLf & o,,"días especiales" & MonthName(Month(Date)) & "" & Year(Date)

' Eliminar
FSO. DeleteFile(Tempfile)

Caso 2' ver el mes que viene
Set objRegEx = CreateObject("VBScript.RegExp")
DateSearch = Right(String(2,"0") & Month(DateAdd("M",1,date)), 2)
objRegEx.Pattern = "^ «& DateSearch

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

END IF

Lazo

' Filtro, añadir y ordenar vacaciones calendario mes
Para i = 0 a 11
Set colMatches = objRegEx.Execute(hol(i))
Si colMatches.Count > 0 entonces
Para cada strMatch en colMatches
arrLines.Add(hol(i))
arrLines.sort()

Terminar si

' Escribir fechas especiales todo a nuevo archivo para los días de semana se pueden agregar
Dim TempFile2
tempfile2 = "c:\Dates.txt"
Set objFile = FSO. OpenTextFile (TempFile2, ForAppending, True)
objFile.Close

' Únete a la matriz con avance de línea
StrNewFile2 DIM: strNewFile2 = Join (arrLines.ToArray, vbCrLf)
' Volver a abrir el archivo para lectura
Set objFile = fso. OpenTextFile (TempFile2, ForWriting, False)
' Escribir el nuevo texto
objFile.Write strNewFile2
objFile.Close

' Open leer, añadir los días de semana y eliminar
Set objFile = fso. OpenTextFile (TempFile2, ForReading)

Hasta objFile.AtEndOfStream
strSearchString = objFile.ReadLine
Set colMatches = objRegEx.Execute(strSearchString)
Si colMatches.Count > 0 entonces
Para cada strMatch en colMatches
' Nombre día de la semana para las vacaciones de enero
Si año (izquierdo (strSearchString, InStr (strSearchString,"")-1))=DateAdd("Y",1,Year(DATE)) entonces
strSearchString = WeekDayName(WeekDay(DateAdd("yyyy",1,(mid(strSearchString,1,2) & "/" & Mid(strSearchString,4,2) & "/" & (Year(Date))) & ":" & strSearchString
' Mes actual es de 12, AnnvMonth es 01 pantalla día de la semana y el total de años para el próximo año
ElseIf mes (fecha) = "12" y Left(strSearchString,2) = "01" y Mid(strSearchString,6,1) = "/" después
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 & "Años"
' Mes actual es de 12, AnnvMonth es 01 sin nombre de día de la semana correcto AnnvYear y diplay
ElseIf mes (fecha) = "12" y Left(strSearchString,2) = "01" y Mid(strSearchString,6,1) = "" entonces
strSearchString = WeekDayName(WeekDay(DateAdd("yyyy",1,(mid(strSearchString,1,2) & "/" & Mid(strSearchString,4,2) & "/" & (Year(Date))) & ":" & strSearchString
' Nombre de día de la semana actual pantalla Annv fecha sin año o vacaciones
Año de elseif (izquierda (strSearchString, InStr (strSearchString,"")-1))=Year(DATE) entonces
strSearchString = WeekDayName(WeekDay(mid(strSearchString,1,2) & "/" & Mid(strSearchString,4,2) & "/" & (year(Date())) & ":" & strSearchString
' Mostrar el nombre del día de la semana y calcular años
Otra cosa
strSearchString = WeekDayName(WeekDay(mid(strSearchString,1,2) & "/" & Mid(strSearchString,4,2) & "/" & (year(Date())) & ":" & strSearchString & ":" & DateDiff("y",year(Left(strSearchString,10)),Year(Date)) & "Años"
END IF

MSG1 = msg1 & strsearchstring & vbcrlf
Siguiente

END IF
Lazo
objFile.Close

' Crear calendario para el próximo mes para agregar al cuadro de mensaje gracias lba
m = Month(DateAdd("M",1,date))
' Si el mes actual es diciembre, desea mostrar el próximo mes y año calendario
Si Month(date) = "12" entonces
Y =Year(DateAdd("YYYY",1,date))
OTRA COSA
Y = Year(Date)
END IF

w = días laborables (DateSerial (y, m, 1), w1) -1
l = Day (DateSerial (y, m + 1, 0)) + w

' Nombres de los días de la primera línea
Para i = 1 a 7
o = o & "" & WeekdayName (i, True) & ""
Siguiente

' Fecha
o = o & vbCrLf
Para i = 1 a l
d = i - c
Si d < 1 entonces
o = o & "--"
otra cosa si Len(d) = 1 then
o = o & "" & d & ""
Otra cosa
o = o & "" & d & ""
Terminar si
End If

Si (i-1) Mod 7 = 6 entonces
o = o & vbCrLf
End If

Siguiente
' Mostrar los resultados
MsgBox Msg1 & vbCrLf & o,,"días especiales" & MonthName(Month(DateAdd("M",1,date))) & "" & Y

' Eliminar
FSO. DeleteFile(Tempfile2)

Caso 3' Añadir nueva fecha
Aviso = "Agregar fecha especial a lista"

Pregunta = InputBox ("Ingrese la fecha y el nombre como" & vbCR & vbCR & "'' nombre DD/MM/AAAA ''" & vbCR & "o" & vbCR & "'' nombre MM/DD ''", aviso)

' Comprobar Null o vacía inputbox luego cancela
IF IsEmpty(Question) entonces
WScript.quit()

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

OTRA COSA
Si (FOE. FileExists(FileName)) entonces
Set objFile = FSO. OpenTextFile (nombre de archivo, ForAppending, True)
objFile.WriteLine (vbCrLf & pregunta)
Otra cosa
Set objFile = FSO. OpenTextFile (nombre de archivo, ForAppending, True)
objFile.WriteLine (pregunta)

objFile.Close

Terminar si

Set arrLines = CreateObject("System.Collections.ArrayList")
' Abrir el archivo
Set objFile = fso. OpenTextFile (nombre de archivo, ForReading, False)
' Bucle a través de y añadir a cada línea en la matriz
Hasta objFile.AtEndOfStream
strLine = Trim(objFile.ReadLine)
Si Len(strLine) > 0 entonces
' Verificar que arsenal ya no tiene la entrada
Si no arrLines.Contains(strLine) entonces arrLines.Add(strLine)
Terminar si
Lazo
objFile.Close
' Ordenar (ascendente) para estética
arrLines.Sort()
' Únete a la matriz con vbCrLf (carro devolver o ingresar)
StrNewFile1 DIM: strNewFile1 = Join (arrLines.ToArray, vbCrLf)
' Volver a abrir el archivo para lectura
Set objFile = fso. OpenTextFile (nombre de archivo, ForWriting, False)
' Escribir el nuevo texto
objFile.Write strNewFile1
objFile.Close

MsgBox "Fecha especial y nombre introducido", aviso
END IF

Quitar fecha de caso 4'
Set fso = CreateObject("Scripting.FileSystemObject")
Aviso = "Que mes?"
Pregunta = InputBox ("Escriba el número del mes ¿te gustaría ver?" & vbCrLf & vbCrLf & "Enter como un número 1-12", aviso)

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

Set objFile = fso. OpenTextFile (nombre de archivo, ForReading)
' Encontrar las fechas de la lista
Hasta objFile.AtEndOfStream
strSearchString = objFile.ReadLine
Set colMatches = objRegEx.Execute(strSearchString)
Si colMatches.Count > 0 entonces
Para cada strMatch en colMatches
MSG = Msg & "" & strSearchString & vbCrLf
Siguiente

End If
Lazo

objFile.Close

IF Len(Msg) = 0 THEN
MsgBox "No hay ninguna fecha en" & MonthName(Question) & "",,"días especiales"
Otra cosa
Aviso = "Escriba la fecha, nombre o ambos a retirarse."
Set objFile = fso. OpenTextFile (nombre de archivo, ForReading)

' Poner la matriz en InputBox
Pregunta = InputBox ("la fecha y el nombre son caso sensible!" & vbCrLf & "ser específico menos escribe más será emparejado y borrado." & vbCrLf & vbCrLf & Msg, aviso)

' Verifica si Inputbox está vacía, cancelar si está vacío
IF IsEmpty(Question) entonces
WScript.quit()
ELSEIF Len(Question) = 0 THEN
WScript.quit()
OTRA COSA
' Eliminar elemento en cuestión
Set objFile = fso. OpenTextFile (nombre de archivo, ForReading)

Hasta objFile.AtEndOfStream
strLine = objFile.ReadLine
Si InStr (strLine, pregunta) = 0 entonces
strNewContents = strNewContents & vbCrLf & strLine
End If
Lazo
Terminar si

objFile.Close

' Reescribir artículos restantes para presentar
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFile = FSO. OpenTextFile (nombre de archivo, ForWriting)
objFile.Write strNewContents
objFile.Close
terminar si
FINAL SELECCIONE
End Sub

' Mensaje de control de errores
IF Err.Number <> 0 entonces
MsgBox "has introducido algo incorrecto. Vuelve a intentarlo. ", 0 + 16," Ooopps... "
WScript.quit()
END IF

Vea el paso

Top de cuero patchwork con anillos de ir a bailar en cuero personalizados para barato.Paso 1: Adquirir chatarra cuero he encontrado mina en el depósito de la ...
Probador de capacidad la batería recargable ¿Tienes un montón de pilas recargables AA en tu cajón? ¿Algunos son viejos, algunos son nuevos, pero que juegos traería ...
Flat Pack Cool Box Hola a todos,Y gracias por hacer clic en mi instructable de mi nevera de paquete plano.Espero que todo está claro y uste ...
N dulce ' fácil Snackers de Oreo Chocolate blanco en este instructable voy a mostrarte cómo hacer un sweeet tratar, Snackers de Oreo!(Justo a tiempo para las vacaciones)P ...
Cubo fijo fijación de un viejo cubo rotoPaso 1: paso 1 tuve un buchet que estaba roto y averiguado cómo arreglarlo.En primer lugar ...