A
Amapola188
Good afternoon
One of my co-workers expects me to keep all my e-mails but I am too lazy to
move them over to a separate folder every so often. So I thought VBA could
help!
I have the following code and it does ask me to specify the date and the
folder but then returns run time error 13 'Type mismatch'. - I have trying
other bits and pieces but can't identify where the problem is. When I choose
debug, the line that causes the error is not highlighted so I don't know
where to start looking.
Any help would be most appreciated! - Thank you! Christine
Private Sub CleanUpMail()
Dim ns As NameSpace
Dim objInbox As MAPIFolder
Dim objSentItems As MAPIFolder
Set ns = ThisOutlookSession.Session
Set objInbox = ns.GetDefaultFolder(olFolderInbox)
Set objSentItems = ns.GetDefaultFolder(olFolderSentMail)
Dim msg As MailItem
Dim strTidyDate As String
Dim varTidyDate As Date
strTidyDate = InputBox( _
Prompt:="Enter the date up to which messages will be moved", _
Title:="Input Date", _
Default:=Date - 60)
'Verify if entered data is a valid date
If Not IsDate(strTidyDate) Then Exit Sub
varTidyDate = CDate(strTidyDate)
'varTidyDate = Format(strTidyDate, "dd/mm/yyyy")
Dim SendToFolder As MAPIFolder
Set SendToFolder = ns.PickFolder
'Run through each item in Sent Items
For Each msg In objSentItems.Items
'Look for message sent before declared date
If msg.SentOn < varTidyDate Then
msg.Move SendToFolder 'need to identify folder
End If
Next
'Run through each item in the Inbox
For Each msg In objInbox.Items
'Look for messages received before specified date
If msg.ReceivedTime < varTidyDate Then
msg.Move SendToFolder 'need to identify folder
End If
Next
End Sub
One of my co-workers expects me to keep all my e-mails but I am too lazy to
move them over to a separate folder every so often. So I thought VBA could
help!
I have the following code and it does ask me to specify the date and the
folder but then returns run time error 13 'Type mismatch'. - I have trying
other bits and pieces but can't identify where the problem is. When I choose
debug, the line that causes the error is not highlighted so I don't know
where to start looking.
Any help would be most appreciated! - Thank you! Christine
Private Sub CleanUpMail()
Dim ns As NameSpace
Dim objInbox As MAPIFolder
Dim objSentItems As MAPIFolder
Set ns = ThisOutlookSession.Session
Set objInbox = ns.GetDefaultFolder(olFolderInbox)
Set objSentItems = ns.GetDefaultFolder(olFolderSentMail)
Dim msg As MailItem
Dim strTidyDate As String
Dim varTidyDate As Date
strTidyDate = InputBox( _
Prompt:="Enter the date up to which messages will be moved", _
Title:="Input Date", _
Default:=Date - 60)
'Verify if entered data is a valid date
If Not IsDate(strTidyDate) Then Exit Sub
varTidyDate = CDate(strTidyDate)
'varTidyDate = Format(strTidyDate, "dd/mm/yyyy")
Dim SendToFolder As MAPIFolder
Set SendToFolder = ns.PickFolder
'Run through each item in Sent Items
For Each msg In objSentItems.Items
'Look for message sent before declared date
If msg.SentOn < varTidyDate Then
msg.Move SendToFolder 'need to identify folder
End If
Next
'Run through each item in the Inbox
For Each msg In objInbox.Items
'Look for messages received before specified date
If msg.ReceivedTime < varTidyDate Then
msg.Move SendToFolder 'need to identify folder
End If
Next
End Sub