running macro for new messages

[Zoroxeus]

Hello


I wrote a macro to insert a text in the opened message:

objItem.body = "hello world" & objItem.Body

So when i click on new message i have to actually run the macro to have this happen.

how can i make this automatic ?
as whenever i open a new mail message the text is inserted automaticly ?


same way is there actually a way to check for a string each time before sending an email and if there is nothig to add a string and then send it ??

thanks a lot !

[matthewspatrick]

To check incoming mail, add this to the ThisOutlookSession module:




Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim arr As Variant
Dim it As Object
Dim Counter As Long

Const StrToInsert As String = "foo"

arr = Split(EntryIDCollection, ",")

For Counter = 0 To UBound(arr)
Set it = Application.Session.GetItemFromID(arr(Counter))
If it.Class = olMail Then
If StrComp(StrToInsert, Left(it.Body, Len(StrToInsert)), vbTextCompare) = 0 Then
' do nothing
Else
it.Body = StrToInsert & vbCrLf & it.Body
it.Save
End If
End If
Next

End Sub

[matthewspatrick]

And to check outgoing mail...



Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

Const StrToInsert As String = "foo"

If Item.Class = olMail Then
If StrComp(StrToInsert, Left(it.Body, Len(StrToInsert)), vbTextCompare) = 0 Then
' do nothing
Else
it.Body = StrToInsert & vbCrLf & it.Body
End If
End If

End Sub

[kbsudhir]

Hi Patrick

I am trying to capture the attributes of teh outgoing mail i.e subject, sent date time etc.

Can I use the same for that also

[kbsudhir]

Hi Patrick

Thanks It is working absolutely fine.

Man u rock

:thumb

[Zoroxeus]

Hi Patrick
thanks for the help.
However what i have been trying to do is for "New mail"
When the user clicks "new email", to write a new email
i want to add a text.
I know it can be done with signature, I would like to know how it can be done through vba.

Because i want a header at the top. and then the cursor after the header, so it's not really a signature.

Thanks for any help !

[Zoroxeus]

PS: your "check outgoing" code is very interesting.
What I do is that I have a rule flagging every incoming email.
Is there a way to check whether there is a flag, and if there is one to "remove" the flag (not set as complete). So that when the other user gets the email they don't see the flag.

Thanks

[Zoroxeus]

Hi,
What about when click on "new mail", when one wants to write a NEW email... without using the signature method
Thanks

[sindhuja]

Hi All,

Is there a way to capture the time of all the e-mails I received with specific subject line

Regards,
Sindhuja

[sindhuja]

Any help on my query... i am struck up with this...

[itanand]

Sindhuja,

I think the folllowing code will work for your requirement.
1.Copy it into your outlook macro VBE.
2. Change the subject as per your Req.
3. Run & check the file @ C:\ path..

Feel free to comment...

Cheers,
Anand

Sub TestTime()
Dim aObjNSMapi As NameSpace
Dim aObjMapiFold As MAPIFolder
Dim intMailCount As Long
Set aObjNSMapi = GetNamespace("MAPI")
Set aObjMapiFold = aObjNSMapi.GetDefaultFolder(olFolderInbox)

For intMailCount = 1 To aObjMapiFold.Items.Count
Dim aObjNewMail As MailItem
Set aObjNewMail = aObjMapiFold.Items(intMailCount)

If UCase(aObjNewMail.Subject) = "TEST MAIL" Then
Open "C:\MailReceivedTimes.txt" For Output As #1
Print #1, intMailCount & " : " & aObjNewMail.SenderName & " : " & aObjNewMail.Subject & " : " & aObjNewMail.ReceivedTime
End If
Next
Close #1
Set aObjNSMapi = Nothing
Set aObjMapiFold = Nothing
Set aObjNewMail = Nothing
End Sub

[sindhuja]

Hi Anand,

Thanks for the heads up !!!
I am very new to VBA. I just went through the coding and found the data is to be stored in the newly created .txt file.

But i need to save data in the already existing .xls file in the respective column.

This might sounds simple.. It would be great if this is done.

-Sindhuja

[itanand]

Sindhuja,

I have modified the VBA code to open the excel & append the values.
You may need to do some changes in the code to make it work for your exact Req...

Note: You have to add the Excel refernce in Tools--> References-->Microsoft Excel 11.0 Object Library

Have a look & Try...

Cheers,
Anand
---------------------------------------------------------------------
Sub TestTime()
Dim aObjNSMapi As NameSpace
Dim aObjMapiFold As MAPIFolder
Dim intMailCount As Long
Dim strSubject As String
Dim strFilePath As String
Dim ExcelApp As Excel.Application
Dim ExcelDoc As Excel.Workbook

strFilePath = "C:\Time.xls"
strSubject = "TEST MAIL"
Set aObjNSMapi = GetNamespace("MAPI")
Set aObjMapiFold = aObjNSMapi.GetDefaultFolder(olFolderInbox)
Set ExcelApp = CreateObject("Excel.Application")
Set ExcelDoc = ExcelApp.Workbooks.Open(strFilePath)
For intMailCount = 1 To aObjMapiFold.Items.Count
Dim aObjNewMail As MailItem
Set aObjNewMail = aObjMapiFold.Items(intMailCount)
If UCase(aObjNewMail.Subject) = strSubject Then
ExcelDoc.Worksheets("Sheet1").Activate
ExcelDoc.Worksheets("Sheet1").Cells(intMailCount, 1) = intMailCount
ExcelDoc.Worksheets("Sheet1").Cells(intMailCount, 2) = aObjNewMail.SenderName
ExcelDoc.Worksheets("Sheet1").Cells(intMailCount, 3) = aObjNewMail.ReceivedTime
End If
Next
Close #1
ExcelDoc.Close
ExcelApp.Quit

Set ExcelApp = Nothing
Set ExcelDoc = Nothing
Set aObjNSMapi = Nothing
Set aObjMapiFold = Nothing
Set aObjNewMail = Nothing
End Sub