M
michaelanderson1
Get date between two dates in month and year format
Hi
I am customising an outlook form. I want contact folder records to be
printed out that fall between 2 dates that are specified as
Month(Written in english ie "March" not 03) and Year(ie 02). The user
will input each desired boundary date in 1 of 2 user input boxes. The
following has been an attempt to use the "=>" and "<=" operators. If i
enter "January 02" in the 2nd input box this is incorrectly read as
02/01/2006.
Is there a function that returns the numeric value of a date? (I know
that 01/01/4501 = 949998) This would be easier to test using the "=>"
and "<=" operators. As a point of reference in New Zealand our date
format is DD/MM/YYYY.
Thanks.
Sub mxzcboRenewal_Click()
Dim objApp As Outlook.Application
Dim fso As Scripting.FileSystemObject
Dim MyFile As Scripting.TextStream
Dim olNS As Outlook.NameSpace
Dim MyFolder As Outlook.MAPIFolder
Dim myItems As Object
Dim objItem As Object
'Declare Renewal variables
Dim mxztxtUserRenewalDateInput1 As Date
Dim mxztxtUserRenewalDateCheck1 As Date
Dim mxztxtUserRenewalDateInput2 As Date
Dim mxztxtUserRenewalDateCheck2 As Date
Dim mxzMembershipRenewalMonthTemp As Date
Dim mxzMembershipRenewalMonthTempDetails As Date
'Declare General form page variables
Dim mxztxtParentCompany As String
Set objApp = CreateObject("Outlook.Application")
Set olNS = objApp.Application.GetNamespace("MAPI")
Set fso = CreateObject("Scripting.FileSystemObject")
'Call Folder Function
Set MyFolder = OpenMAPIFolder("\Test1\Contacts")
Set MyFile = fso.CreateTextFile("c:\testfileAdmin52.txt", True)
'Get first user date variable
mxztxtUserRenewalDateInput1 = InputBox("Please Insert First
Renewal Date Month", _
"Please Insert First Renewal Date Month", "January 00")
If IsDate(mxztxtUserRenewalDateInput1) = True Then
mxztxtUserRenewalDateCheck1 =
DateValue(mxztxtUserRenewalDateInput1)
Else: MsgBox "Enter Valid Date"
End If
'Get second user date variable
mxztxtUserRenewalDateInput2 = InputBox("Please Insert Second
Renewal Date Month", _
"Please Insert Second Renewal Date Month", "January 00")
If IsDate(mxztxtUserRenewalDateInput2) = True Then
mxztxtUserRenewalDateCheck2 =
DateValue(mxztxtUserRenewalDateInput2)
Else: MsgBox "Enter Valid Date"
End If
For Each objItem In MyFolder.Items
'Enter records date variables into another Date
mxzMembershipRenewalMonthTemp = _
objItem.UserProperties("mxzMembershipRenewalMonth").Value
mxzMembershipRenewalMonthTempDetails =
DateValue(mxzMembershipRenewalMonthTemp)
If (mxzMembershipRenewalMonthTempDetails >=
mxztxtUserRenewalDateCheck1) And _
(mxzMembershipRenewalMonthTempDetails <=
mxztxtUserRenewalDateCheck2) Then
'Assign values to General form page variables
mxztxtParentCompany =
objItem.UserProperties("mxzParentCompany")
MyFile.WriteLine ("Record:" & " " &
mxztxtParentCompany)
End If
Next
'Release General variables
Set fso = Nothing
Set olNS = Nothing
Set MyFolder = Nothing
Set objItem = Nothing
End Sub
'Function to get Folder Path
Public Function OpenMAPIFolder(ByVal strPath) As MAPIFolder
Dim objFldr As MAPIFolder
Dim strDir As String
Dim strName As String
Dim i As Integer
On Error Resume Next
If Left(strPath, Len("\")) = "\" Then
strPath = Mid(strPath, Len("\") + 1)
Else
Set objFldr = Application.ActiveExplorer.CurrentFolder
End If
While strPath <> ""
i = InStr(strPath, "\")
If i Then
strDir = Left(strPath, i - 1)
strPath = Mid(strPath, i + Len("\"))
Else
strDir = strPath
strPath = ""
End If
If objFldr Is Nothing Then
Set objFldr =
Application.GetNamespace("MAPI").Folders(strDir)
On Error GoTo 0
Else
Set objFldr = objFldr.Folders(strDir)
End If
Wend
Set OpenMAPIFolder = objFldr
End Function
Hi
I am customising an outlook form. I want contact folder records to be
printed out that fall between 2 dates that are specified as
Month(Written in english ie "March" not 03) and Year(ie 02). The user
will input each desired boundary date in 1 of 2 user input boxes. The
following has been an attempt to use the "=>" and "<=" operators. If i
enter "January 02" in the 2nd input box this is incorrectly read as
02/01/2006.
Is there a function that returns the numeric value of a date? (I know
that 01/01/4501 = 949998) This would be easier to test using the "=>"
and "<=" operators. As a point of reference in New Zealand our date
format is DD/MM/YYYY.
Thanks.
Sub mxzcboRenewal_Click()
Dim objApp As Outlook.Application
Dim fso As Scripting.FileSystemObject
Dim MyFile As Scripting.TextStream
Dim olNS As Outlook.NameSpace
Dim MyFolder As Outlook.MAPIFolder
Dim myItems As Object
Dim objItem As Object
'Declare Renewal variables
Dim mxztxtUserRenewalDateInput1 As Date
Dim mxztxtUserRenewalDateCheck1 As Date
Dim mxztxtUserRenewalDateInput2 As Date
Dim mxztxtUserRenewalDateCheck2 As Date
Dim mxzMembershipRenewalMonthTemp As Date
Dim mxzMembershipRenewalMonthTempDetails As Date
'Declare General form page variables
Dim mxztxtParentCompany As String
Set objApp = CreateObject("Outlook.Application")
Set olNS = objApp.Application.GetNamespace("MAPI")
Set fso = CreateObject("Scripting.FileSystemObject")
'Call Folder Function
Set MyFolder = OpenMAPIFolder("\Test1\Contacts")
Set MyFile = fso.CreateTextFile("c:\testfileAdmin52.txt", True)
'Get first user date variable
mxztxtUserRenewalDateInput1 = InputBox("Please Insert First
Renewal Date Month", _
"Please Insert First Renewal Date Month", "January 00")
If IsDate(mxztxtUserRenewalDateInput1) = True Then
mxztxtUserRenewalDateCheck1 =
DateValue(mxztxtUserRenewalDateInput1)
Else: MsgBox "Enter Valid Date"
End If
'Get second user date variable
mxztxtUserRenewalDateInput2 = InputBox("Please Insert Second
Renewal Date Month", _
"Please Insert Second Renewal Date Month", "January 00")
If IsDate(mxztxtUserRenewalDateInput2) = True Then
mxztxtUserRenewalDateCheck2 =
DateValue(mxztxtUserRenewalDateInput2)
Else: MsgBox "Enter Valid Date"
End If
For Each objItem In MyFolder.Items
'Enter records date variables into another Date
mxzMembershipRenewalMonthTemp = _
objItem.UserProperties("mxzMembershipRenewalMonth").Value
mxzMembershipRenewalMonthTempDetails =
DateValue(mxzMembershipRenewalMonthTemp)
If (mxzMembershipRenewalMonthTempDetails >=
mxztxtUserRenewalDateCheck1) And _
(mxzMembershipRenewalMonthTempDetails <=
mxztxtUserRenewalDateCheck2) Then
'Assign values to General form page variables
mxztxtParentCompany =
objItem.UserProperties("mxzParentCompany")
MyFile.WriteLine ("Record:" & " " &
mxztxtParentCompany)
End If
Next
'Release General variables
Set fso = Nothing
Set olNS = Nothing
Set MyFolder = Nothing
Set objItem = Nothing
End Sub
'Function to get Folder Path
Public Function OpenMAPIFolder(ByVal strPath) As MAPIFolder
Dim objFldr As MAPIFolder
Dim strDir As String
Dim strName As String
Dim i As Integer
On Error Resume Next
If Left(strPath, Len("\")) = "\" Then
strPath = Mid(strPath, Len("\") + 1)
Else
Set objFldr = Application.ActiveExplorer.CurrentFolder
End If
While strPath <> ""
i = InStr(strPath, "\")
If i Then
strDir = Left(strPath, i - 1)
strPath = Mid(strPath, i + Len("\"))
Else
strDir = strPath
strPath = ""
End If
If objFldr Is Nothing Then
Set objFldr =
Application.GetNamespace("MAPI").Folders(strDir)
On Error GoTo 0
Else
Set objFldr = objFldr.Folders(strDir)
End If
Wend
Set OpenMAPIFolder = objFldr
End Function