Sub DateStamp()
'by simon rickell
Dim objApp As Application
Dim objItems As Object
Dim objItem As Object
Dim objNS As NameSpace
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objItems = objApp.ActiveExplorer.Selection
For Each objItem In objItems
If objItem.Class = olMail Then
If Left$(objItem.Subject, Len(objItem.SentOn)) <> Format(objItem.SentOn, "YYYY-MM-DD HH:MM:SS") Then
objItem.Subject = Format(objItem.SentOn, "YYYY-MM-DD HH:MM:SS") & "-" & objItem.Subject
objItem.Save
End If
End If
Next
Set objItem = Nothing
Set objNS = Nothing
Set objApp = Nothing
End Sub
Sub Create_Button()
Dim cbTesting As CommandBar
Dim ctlCBarButton As CommandBarButton
Dim ctlCBarCombo As CommandBarComboBox
Dim ctlCBarPopup As CommandBarPopup
On Error Resume Next
Set cbTesting = Application.ActiveExplorer.CommandBars("Shepherd")
If Err = 0 Then
cbTesting.Delete
End If
Set cbTesting = Application.ActiveExplorer.CommandBars _
.Add(Name:="Shepherd", Position:=msoBarTop)
Set ctlCBarButton = cbTesting.Controls.Add(Type:=msoControlButton)
With ctlCBarButton
.Caption = "Date Stamp"
.FaceId = 2167
.Style = msoButtonCaption
.Visible = True
.OnAction = "Project1.ThisOutlookSession.DateStamp"
.TooltipText = "Date stamp an item of mail with the received date"
End With
cbTesting.Visible = True
End Sub
Sub CCProjMail()
'by Allan Scott
Sub Application_ItemSend(ByVal MailItem As Object, Cancel As Boolean)
Dim projMail As String
Dim ask As String
ask = MsgBox("Send a copy to 'Computer Helpdesk' Project Mail Box?", _
vbYesNo + vbQuestion, "Project eMail")
If ask = vbNo Then
'Resolve the address
MailItem.Recipients.ResolveAll
MsgBox ("Your email will be sent as normal"), vbOKOnly + vbInformation
Else: ask = vbYes
projMail = ("")
MailItem.CC = MailItem.CC & ";" & projMail
'Resolve the address
MailItem.Recipients.ResolveAll
MsgBox ("Your email will be sent with a copy sent to 'Computer Helpdesk' Project Mail Box"), _
vbOKOnly + vbInformation
End If
End Sub