First I create an email via Outlook:
Sub CreateHTMLMail()
'Creates a new e-mail item and modifies its properties.
Dim olApp As Outlook.Application
Dim objMail As Outlook.MailItem
Set olApp = Outlook.Application
'Create e-mail item
Set objMail = olApp.CreateItem(olMailItem)
Dim sHTML_Open As String
Dim sHTML_Introduction As String
Dim sHTML_Goodbye As String
Dim sHTML_Close As String
Dim sHTML_Process_Date As String
Dim sHTML_Processor As String
Dim sHTML_Issuer As String
Dim sHTML_Details As String
Dim sHTML_Body As String
sHTML_Open = "<HTML><BODY>"
sHTML_Introduction = "Hi team,<BR/><BR/>" & _
"Data is ready to process. Please find details as below.<BR/>"
sHTML_Process_Date = "<P ID='PROCESSDATE'>28 February 2013</P>"
sHTML_Processor = "<P ID='PROCESSOR'>AKSHAY</ID></P>"
sHTML_Issuer = "<P ID='ISSUER'>DATAGROUP.COM</ID></P>"
sHTML_Details = "<P ID='DETAILS'>" & _
"<UL>" & _
"<LI>Fimta23456 09:00:00 flor345</LI>" & _
"<LI>Fimta23456 09:00:00 flor345</LI>" & _
"</UL>" & _
"</P><BR/>"
sHTML_Goodbye = "Thanks"
sHTML_Close = "</BODY></HTML>"
sHTML_Body = sHTML_Open & sHTML_Introduction & sHTML_Process_Date & sHTML_Processor & sHTML_Issuer & _
sHTML_Details & sHTML_Goodbye & sHTML_Close
With objMail
'Set body format to HTML
.BodyFormat = olFormatHTML
.To = "Kim Gysen"
.Subject = "data remit file"
.HTMLBody = sHTML_Body
.Display
End With
End Sub
Via code, I want to retrieve values based on ID.
This seemed the cleanest way for me, I don't particulary like the "split" method because it's kind of hard coding; not very dynamic and kinda unreliable.
Unfortunately when I retrieve the HTML body, I cannot retrieve the original HTML, as it is distorted by Outlook:
Sub Get_OL()
Dim oFolder As MAPIFolder
Dim oItem As Variant
Dim sHTML_Body As String
Dim sHTML_Process_Date As String
Dim sHTML_Processor As String
Dim sHTML_Issuer As String
Dim sHTML_Details As String
Dim oExcel As Object
Dim oBook As Workbook
Set oExcel = CreateObject("Excel.Application")
Set oBook = oExcel.Workbooks.Add
'Access the outlook inbox folder
Set oFolder = GetNamespace("MAPI").PickFolder
'On error resume next usually not to use, but feteching emails may give unexpected errors
On Error Resume Next
For Each oItem In oFolder.Items
If TypeOf oItem Is Outlook.MailItem Then
If oItem.Subject Like "*data remit file*" Then
'Turn off on error resume next asap
On Error GoTo 0
sHTML_Body = oItem.HTMLBody
Debug.Print sHTML_Body
Exit For
End If
End If
Next oItem
End Sub
On debug.print, this is what I get (only putting the last line of the Format):
</o:shapelayout></xml><![endif]--></head><body lang=EN-GB link=blue vlink=purple><div class=WordSection1><p class=MsoNormal>Hi team,<br><br>Data is ready to process. Please find details as below.<br><br><o:p></o:p></p><p>28 February 2013<o:p></o:p></p><p id=PROCESSOR>AKSHAY<o:p></o:p></p><p id=ISSUER>DATAGROUP.COM<o:p></o:p></p><ul type=disc><li class=MsoNormal style='mso-margin-top-alt:auto;mso-margin-bottom-alt:auto;mso-list:l0 level1 lfo1'>Fimta23456 09:00:00 flor345<o:p></o:p></li><li class=MsoNormal style='mso-margin-top-alt:auto;mso-margin-bottom-alt:auto;mso-list:l0 level1 lfo1'>Fimta23456 09:00:00 flor345<o:p></o:p></li></ul><p class=MsoNormal><br>Thanks<o:p></o:p></p></div></body></html>
I would like to retrieve the original HTML that I put in the HTMLBody.
2 ways:
1) parsing text - several things to do (not recommended: hard-coding)
All what you need is to parse text, but MSDN shows how to do it using InStr function. I would strongly suggest to use RegEx to parse html text. Note: reference to MS VBScript Regular Expressions x.x is needed.
Simple Regular Expression Tutorial for Excel VBA
2) using UserProperites of MailItem object (recommended)
If MailItem doesn't contains your propert(y)ies, than there is nothing to do ;)
How to: Add custom property
Related
I below code to replyall to email shows
"Run-time error 13 type mismatch"
when it runs to Next (for each next loop).
I set up the rule for email received today. When it comes to next (next date), it shows the error message.
I debugged, it stopped the error message until the received-time is today.
sub fwdmail ()
dim i as long
dim otlk as outlook.application
dim nmspc as outlook.namespace
dim olmail as Outlook.MailItem
dim objfolder as Outlook.MAIPfolder
dim oreply as Outlook.MailItem
set otlk=New Outlook.Applicaiton
Set Nmsp=otlk.GetNamespace("MAPI")
Set objfolder=nmspc.getdefaultFolder("olFolderInbox).Folder("notice")
for each olmail in objfolder.Items
if olmail.ReceivedTime>=Format(Date, "YYYY/MM/DD") then
' do the stuff here
end if
next
I tired to check if a mailitem type, but got the same error message.
for each olmail in objfolder.Items
if typeof olmail is outlook.item then
if olmail.ReceivedTime>=Format(Date, "YYYY/MM/DD") then
' do the stuff here
end if
end if
next
I would suggest comparing the format of the received time with the format you are comparing to.
Declare a variable that allows all types of items. Test that to see if it is a mailitem.
Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
Sub fwdmail()
Dim olNmspc As NameSpace
Dim olFolder As folder
Dim olItm As Object ' <-- Items may not be mailitems
Dim olMitm As MailItem
Set olNmspc = GetNamespace("MAPI")
' Multiple lines allows easier troubleshooting
Set olFolder = olNmspc.GetDefaultFolder(olFolderInbox)
Set olFolder = olFolder.folders("notice")
For Each olItm In olFolder.Items
If TypeOf olItm Is MailItem Then ' <-- test if item is a mailitem
Set olMitm = olItm
If olMitm.ReceivedTime >= Format(Date, "YYYY/MM/DD") Then
' do the stuff here
Debug.Print "olMitm.Subject......: " & olMitm.Subject
Debug.Print " olMitm.ReceivedTime: " & olMitm.ReceivedTime
Debug.Print " Format date........: " & Format(Date, "YYYY/MM/DD")
Debug.Print
End If
End If
Next
End Sub
I am helping my friend to develop her codes using VBA. I have successfully run these codes in my laptop yet she is encountering errors when we copy the codes to her machine.
Here's my code:
Sub Test()
Call sendingEmailWithChecklist("Book1.xlsm")
End Sub
Sub sendingEmailWithChecklist(workbookName As String)
Dim recipient As String
Dim cc As String
Dim subject As String
Dim body As Range
Dim greetings As String
Dim message As String
Dim signature As String
Dim ebody As String
Dim olApp As Outlook.Application
Dim olInsp As Outlook.Inspector
Dim wdDoc As Word.Document
Dim olEmail As Outlook.MailItem
Dim worksheetName As String
Dim content As Range
Set olApp = New Outlook.Application
Set olEmail = olApp.CreateItem(olMailItem)
Sheet2.Activate
recipient = Range("B3").Value
cc = Range("B4").Value
subject = Range("B5").Value
greetings = Range("B6").Value
message = Range("B7").Value
ebody = greetings & vbNewLine & vbNewLine & message & vbNewLine
signature = Range("B8").Value
'Workbooks(workbookName).Activate
worksheetName = "Sheet1"
With olEmail
.Display
.To = recipient
.cc = cc
.subject = subject
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Workbooks(workbookName).Worksheets(worksheetName).Activate
Workbooks(workbookName).Worksheets(worksheetName).Cells.Copy
'Range("A1:F17").Select
'Selection.Copy
End With
With olEmail
.Display
wdDoc.Range(1, 1).Paste
wdDoc.Range.InsertBefore ebody
'.Send
End With
End Sub
wdDoc.Range(1,1).Paste was her error. We have both declared same references from tools yet the error is still on this line. What could be the possible error why it doesn't run on her machine?
PS. She doesn't want to use HTMLbody.
Instead of
wdDoc.Range(1, 1).Paste
Try
wdDoc.Range.Paste
If you want to further control the way you paste your data in the body of mail you may want to use the Word Selection object (expression) instead of Range. Something like:
wdDoc.Application.Selection.PasteAndFormat wdFormatOriginalFormatting
Above paste the copied item with its original formatting. You may select other PasteAndFormat options depending on your expected outcome.
I have some script which attaches and sends a file based on some incoming e-mail rules which works perfectly.
Sub AddAttachment(Item As Outlook.MailItem)
Dim myOlApp As Outlook.Application
Dim myItem As Outlook.MailItem
Dim myAttachments As Outlook.Attachments
Set myOlApp = CreateObject("Outlook.Application")
Set myItem = myOlApp.CreateItemFromTemplate("C:\Templates\test upload file.oft")
Set myAttachments = myItem.Attachments
myAttachments.Add "C:\TEST\150520ABCDE.txt"
myItem.Send
End Sub
Trouble I have is the attachment file name "150520ABCDE.txt" changes daily. "150520" being the date.
I therefore have some more script which should assign the correct file name based on date.
Function LPad (str, pad, length)
LPad = String(length - Len(str), pad) & str
End Function
y = Year(Now)
m = Month(Now)
d = Day(Now)
f = "C:\Test\" & Mid(y, 3, 2) & LPad(m, "0", 2) & LPad(d, "0", 2) & "ABCDE.txt"
myAttachments.Add f
My question is how do I tie them both together in to one script?
What I actually would do instead is:
Sub AddAttachment(Item As Outlook.MailItem)
Dim myOlApp As Outlook.Application
Dim myItem As Outlook.MailItem
Dim myAttachments As Outlook.Attachments
Set myOlApp = CreateObject("Outlook.Application")
Set myItem = myOlApp.CreateItemFromTemplate("C:\Templates\test upload file.oft")
Set myAttachments = myItem.Attachments
myAttachments.Add "C:\TEST\" & Format(Date, "yymmdd") & "ABCDE.txt"
myItem.Send
End Sub
Hope this helps
I have noticed the following line of code in the script:
Set myOlApp = CreateObject("Outlook.Application")
Why do you need to create a new Outlook Application instance in the code? Instead, you may use the Application property in VBA or just use the passed argument to retrieve the required properties.
Sub AddAttachment(Item As Outlook.MailItem)
Dim myOlApp As Outlook.Application
Dim myItem As Outlook.MailItem
Dim myAttachments As Outlook.Attachments
Set myOlApp = CreateObject("Outlook.Application")
Set myItem = myOlApp.CreateItemFromTemplate("C:\Templates\test upload file.oft")
Set myAttachments = myItem.Attachments
myAttachments.Add "C:\Test\" & Mid(Year(Now), 3, 2) & LPad(Month(Now), "0", 2) & LPad(Day(Now), "0", 2) & "ABCDE.txt"
' or simply use the Format method
' myAttachments.Add "C:\TEST\" & Format(Date, "yymmdd") & "ABCDE.txt"
myItem.Send
End Sub
Function LPad (str, pad, length)
LPad = String(length - Len(str), pad) & str
End Function
Finally, you may find the Getting Started with VBA in Outlook 2010 article helpful.
I'm having trouble with automatically exporting the body of an email into a text file using a script.
I've managed a script that will save the text into a file on a macro but that won't work on a rule which is what I need.
My current code is as follows:
Sub SaveAsTXT()
Dim myItem As Outlook.Inspector
Dim objItem As Object
Dim myFolder As Folder
Set myItem = Application.ActiveInspector
If Not TypeName(myItem) = "Nothing" Then
Set myNamespace = Application.GetNamespace("MAPI")
Set myFolder = myNamespace.GetDefaultFolder(olFolderInbox)
Set objItem = myItem.CurrentItem
strname = objItem.Subject
strdate = Format(objItem.ReceivedTime, " yyyy mm dd")
objItem.SaveAs "c:\users\philip\documents\" & strname & strdate & ".txt", olTXT
End If
End Sub
Apologies if it looks a bit messy, I've edited it countless times trying to get it to work.
That's the code that will correctly run when I'm in the open email and run it as a macro but it won't work correctly when run as a rule
I have tried amending to Sub SaveAsTXT(Item as Outlook.Mailitem) but this also doesn't seem to work
So basically the question is how to I ensure the code will select the email (which will always be entitled "Rotas" without quotes) when it is run as a rule?
Info: Using office 2010 and I'm not a very good coder to start with.
Actually I managed to sort it out myself.
I didn't consider that the item as Outlook.Mailitem element was actually the thing that was selected by the rule. So I applied item as the object rather than objItem
Find the successful (and cleaned up) code below:
Sub SaveAsTXT(myMail As Outlook.MailItem)
Dim objItem As Object
Dim myFolder As Folder
If Not TypeName(myitem) = "Nothing" Then
If myMail.Subject = "Rotas" Then
strname = myMail.Subject
strdate = Format(myMail.ReceivedTime, " yyyy mm dd")
myMail.SaveAs "c:\users\philip\documents\" & strname & ".txt", olTXT
End If
End If
End Sub
Im really new to VBA and need some help. I'm trying to write a VBA script (along with a Outlook rule) to automatically download attachments from daily emails and append the file names with the date that appears in the subject.
This is what the subject line looks like - "Email Alert for Department for 10/20/2014". I just need to isolate the rightmost 10 spaces that indicates the run date of the files.
So I found code online that works to automatically download the attachments and append by current date which does work. See below.
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim dateFormat
dateFormat = Format(Now, "yyyymmdd ")
saveFolder = "Z:\Daily Emails"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & dateFormat & objAtt.DisplayName
Set objAtt = Nothing
Next
End Sub
I also found online that something like this should point to the date (formatted like XX/XX/XXXX and always at the end of the subject line.
Subject = Right(itm.Subject, 10) but im having trouble incorporating it into the code above.
Can anyone help me? It would mean a lot
Thanks!
-Christina
Using Rules to run a macro is good.
I used the same set up before. The problem is if you are to work on the newly received mail, the sub wouldn't trap it. If you need to save the attachment of an incoming email with Email Alert for Department for mm/dd/yyyy as subject, try using an event instead. By default, Outlook doesn't provide Items Event so you'll have to create it.
In your ThisOutlookSession (not in a module) try something like:
Option Explicit
Private WithEvents olIBoxItem As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
'~~> change olFolder depending on what folder you're receiving the email
'~~> I assumed it is Outlook's default folder Inbox
Set olIBoxItem = olFolder.Items
End Sub
Private Sub olIBoxItem_ItemAdd(ByVal Item As Object)
Const strSub As String = "Email Alert for Department for "
If TypeOf Item Is Outlook.MailItem Then
Dim nMail As Outlook.MailItem
Set nMail = Item
If InStr(nMail.Subject, strSub) <> 0 Then
Const savefolder As String = "Z:\Details Mail\"
'~~> Extract your date
Dim dateSub As String: dateSub = Right(nMail.Subject, 10)
'~~> Make sure there is an attachment
If nMail.Attachments.Count > 0 Then
Dim olAtt As Outlook.Attachment
Set olAtt = nMail.Attachments.Item(1) '~~> if you only have 1
Dim attFName As String, addFExt As String
'~~> Get the filename and extension separately
attFName = Split(olAtt.Filename, ".")(0)
attFExt = Split(olAtt.Filename, ".")(1)
'~~> Reconstruct the filename
attFName = savefolder & attFName & " " & dateSub & attFExt
'~~> Save the attachment
olAtt.SaveAsFile attFName
End If
End If
End If
End Sub
So above routine automatically checks any received mail in the Inbox Folder. If the subject contains the specified string. If yes, it automatically saves the attachment.
If however you have more than one attachment, you'll have to look through it and then save each one. It may look confusing at first but you'll get the hang of it for sure. HTH.