Outlook macro with today's date in subject and paste clipboard in body

[Dan1sh]

Hi Everyone,

Very new to VBA. I write similar emails everyday to the same email address. I needed some help to automate it using VBA macros.
Basically, I want:

To: xyz at xyz com

Subject: 'TEXT' & todays date & the sent email counter(if possible)

Body: Paste Clipboard item
Send
Can somebody please help me with this?
Thanks in advance.

[gmayor]

Where is the clipboard item copied from?
What does the sent mail counter count? All the mails you have ever sent? The messages you have sent today? Some other count?
What does TEXT represent in the subject?

[Dan1sh]

Where is the clipboard item copied from?
What does the sent mail counter count? All the mails you have ever sent? The messages you have sent today? Some other count?
What does TEXT represent in the subject?

Clipboard item is copied from a text file.
Sent mail counter is for the messages I have sent today.
TEXT just represents the same sentence I put in subjects of all the emails.

Thank you for your reply.

[gmayor]

OK try the following


Option Explicit

Sub CreateMessageFromClipboard()
Dim olEmail As Outlook.MailItem
Dim olItem As MailItem
Dim olInsp As Outlook.Inspector
Dim wdDoc As Object
Dim oRng As Object
Dim olitems As Items
Dim lngCount As Long: lngCount = 0
Const strSubject As String = "Fixed Text" ' This is the fixed text for the subject
Const strRecipient As String = "someone@somewhere.com"


Set olitems = Session.GetDefaultFolder(olFolderSentMail).Items
olitems.Sort "[Received]", True
For Each olItem In olitems
If Format(olItem.SentOn, "yyyymmdd") = Format(Date, "yyyymmdd") Then
lngCount = lngCount + 1
Else
Exit For
End If
DoEvents
Next olItem
On Error Resume Next
Set olEmail = CreateItem(olMailItem)
With olEmail
.To = strRecipient
.Subject = strSubject & Chr(32) & Format(Date, "dd/mm/yyyy") & " (" & lngCount & ")"
.BodyFormat = olFormatHTML
.Display
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range(0, 0)
oRng.PasteSpecial DataType:=2
End With
lbl_Exit:
Set olEmail = Nothing
Set olInsp = Nothing
Set olitems = Nothing
Set wdDoc = Nothing
Set oRng = Nothing
Exit Sub
End Sub

[Dan1sh]

OK try the following


Option Explicit

Sub CreateMessageFromClipboard()
Dim olEmail As Outlook.MailItem
Dim olItem As MailItem
Dim olInsp As Outlook.Inspector
Dim wdDoc As Object
Dim oRng As Object
Dim olitems As Items
Dim lngCount As Long: lngCount = 0
Const strSubject As String = "


Set olitems = Session.GetDefaultFolder(olFolderSentMail).Items
olitems.Sort "[Received]", True
For Each olItem In olitems
If Format(olItem.SentOn, "yyyymmdd") = Format(Date, "yyyymmdd") Then
lngCount = lngCount + 1
Else
Exit For
End If
DoEvents
Next olItem
On Error Resume Next
Set olEmail = CreateItem(olMailItem)
With olEmail
.To = strRecipient
.Subject = strSubject & Chr(32) & Format(Date, "dd/mm/yyyy") & " (" & lngCount & ")"
.BodyFormat = olFormatHTML
.Display
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range(0, 0)
oRng.PasteSpecial DataType:=2
End With
lbl_Exit:
Set olEmail = Nothing
Set olInsp = Nothing
Set olitems = Nothing
Set wdDoc = Nothing
Set oRng = Nothing
Exit Sub
End Sub




Thank you so much for your help. Sorry couldn't back to you, had to go overseas. I just tried the code and it works like a charm. Thank you so so much. You are a legend!!!!