Solved: Outlook Body Text to Text File, Scripting and Guard Issues

[andysuth]

Hi,

I want to be able to configure Outlook to run a few simple batch files whilst I'm away from my desk (in meeting, email a few commands from a handheld, and PDF sent to my boss whilst I'm still in meeting).

Most of this is working, except I need to approve the saveas/ file write to have access to my "Address book" each time it saves the text from an email. This defeats the object.

I got that problem when I used this format:


'------------------------------------------------
Public Sub PRS(MyMail As MailItem)
Set fso = CreateObject("Scripting.FileSystemObject")
Set aFile = fso.CreateTextFile(strTarget & "C:\PRS\REALLY_PAR.txt", True)
parastring = MyMail.Body

aFile.WriteLine (parastring)
aFile.Close

Set fso = Nothing
Set aFile = Nothing

End Sub

'------------------------------------------------



Since then I've been through archieves and found a posting on this website, which flashed up the contents of a email (text only) as a MSGBOX string, I've modded that to the following. This *almost* works, but unfortunately when the email comes in with the code word in subject line, it doesn't auto select, so after the command comes in, it saves the text from the last email I was looking at to the text file. -No Good! -

Here's the modded text macro, any ideas? :




'------------------------------------------------
Sub GetSelectedMailText()
Set fso = CreateObject("Scripting.FileSystemObject")
Set aFile = fso.CreateTextFile(strTarget & "C:\PRS\PAR.txt", True)
Dim myOlSel As Outlook.Selection
Dim strText As String

'check there's something selected
If Application.ActiveExplorer.Selection.Count = 1 Then
Set myOlSel = Application.ActiveExplorer.Selection
strText = myOlSel.Item(1).Body
'do something with the mail item body text

aFile.WriteLine (strText)
aFile.Close

End If

Set fso = Nothing
Set aFile = Nothing
End Sub

'------------------------------------------------



Thanks in advance.

-Andy S

[andysuth]

Anyone any ideas?

Cheers.

-Andy

[andysuth]

Anyone any ideas on this?

I know I can do it by saving a textfile and opening that, but it kind of negates the object if its sooooo convoluted.

HELP!

-AS

[mvidas]

Hi Andy,

We can get this working for you.. the original PRS macro above looks like one you'd call from a Rule, so I'm guessing you have 2003? It is a lot less code using 2003 since you can send an email to a sub like that, the other thread (http://www.vbaexpress.com/forum/showthread.php?t=13438) is an example of how you could do it using only events (and I'd be happy to help modify that for you if you cant use the Rules).

As for the 'need to approve the saveas/ file write to have access to my "Address book"', check out http://www.mapilab.com/outlook/security for a free add-in that will click that box for you automatically. You can also get a (free) standalone program called ClickYes to do the same, I've heard the mapilab addin is nicer since it integrates into outlook (I still use OL2000 -- no security popups :))

Also, to make it easier, FYI
I'll take care of the code snippets above though :)

[andysuth]

Hi Andy,

We can get this working for you.. the original PRS macro above looks like one you'd call from a Rule, so I'm guessing you have 2003? It is a lot less code using 2003 since you can send an email to a sub like that, the other thread is an example of how you could do it using only events (and I'd be happy to help modify that for you if you cant use the Rules).
:)

I've got a modified form of the other thread working for saving a text file, so I think I can get this going now, though obviously I'm an engineer, not a programmer, so it'll be a little messy!

I'll let you know how I get on!

-Andy

[andysuth]

Yes, it's 2003 I'm doing this with, and I'm not sure how the IT dept would take it if I were to put a "Click Yes" bypass on that security measure.

-AS

[mvidas]

Though I haven't personally used it, I believe I read the MAPILab addin allows for some customization, ie. it would only Click Yes for certain procedures, and not all. So if you did get some kind of virus that tried to do harm it wouldn't click yes for that automatically, only your chosen macro.

[andysuth]

OK, having looked further into it, I think I will need a little help here.

I originally had a Rule that if the title contained the word "AutoStair" it would run this batch file from a command line.

That batch file then calls a parameter file of the form:

param.txt
=================
nosteps = 23
width = 1000
holes= 8
height = 1200
=================

If this param.txt file was exactly the same as the contents of the email body, then I could basically finish the rest.

I do like the routine you've done on the other thread, and as I said I'm probably not allowed a "Click Yes" application on a work machine, so if there was an easy alteration that could be done on the other text I think that would really KICK

-AS

[mvidas]

Having never had to deal with that security prompt I don't think there are any tricky ways around it (aside from the standalone program or outlook add-in).

What you could do (unrelated to the security thing) is change that AutoStair rule to "Run a script" as the desired action, and for the macro choose this:Sub CheckMessageAgainstFile(vMsg As MailItem)
Dim vFF As Long, vFile As String, FileContents As String
vFile = "C:\param.txt" 'file to compare against

'load file into string variable
vFF = FreeFile
Open vFile For Binary Access Read As #vFF
FileContents = Space$(LOF(vFF))
Get #vFF, , FileContents
Close #vFF

If FileContents = vMsg.Body Then
'message has same text as file
End If
End Sub
That way each message that fits the rule will be sent to this sub, which will compare the text file to the contents of the message. Is that what you're looking to do, or did I read it wrong?

[andysuth]

Having never had to deal with that security prompt I don't think there are any tricky ways around it (aside from the standalone program or outlook add-in).

What you could do (unrelated to the security thing) is change that AutoStair rule to "Run a script" as the desired action, and for the macro choose this:

Sorry, I was clear as mud last post, I just want to save the contents of an email body as a text file.

What I'd been trying to say was if the email was already sent formatted, then there would be minimal processing, and a straight
writeline (Mail.body)
type arrangement would do the job!

If the last routine you wrote in the other thread could be made to just copy the contents of the email body into a text file, the rest should run (with a little shoe-horning!)

Thanks,

-Andy.


-AS

[mvidas]

Well I still say you should use the Run As Script option in a rule, ie with something likeSub SaveMessageToFile(vMsg As MailItem)
Dim vFF As Long, vFile As String
vFile = "C:\saved.txt" 'file to save to

'save message to text file
vFF = FreeFile
Open vFile For Output As #vFF
Print #vFF, Msg.Body
Close #vFF
End SubBut if you mean by that other thread that you want to check for a certain pattern in the message body before saving (to see if its formatted as you want it), we could add that to the script above too (regular expressions, which i used in the other thread, would make it simple). The other thread just gives a workaround to running a macro from a rule, as I wasn't sure what version he had :)

[andysuth]

It's not that, it's more the fact your last one (maybe because it was formatting) didn't trigger the guard on my O2003, I've got this one running from a rule again, and I find it trips the guard.

btw, had to make two minor alterations to the program before it ran:
<vba>
Public Sub SaveMessageToFile(vMsg As MailItem)
Dim vFF As Long, vFile As String
vFile = "C:\saved.txt" 'file to save to

'save message to text file
vFF = FreeFile
Open vFile For Output As #vFF
Print #vFF, vMsg.Body
Close #vFF
End Sub
</vba>

[andysuth]

I've just cross-bred your two routines and come up with this nasty looking piece.

It now (in combination with your last routines on other thread) saves the entire, unedited body of message as a text file in the root directory as savem2e.txt.

I think I can tidy up and get this thing working, but if oyu have any tips, would be greatly appreciated.

Thanks for your help, if you need any help with ProE, SldWKS, SldEdge or Inventor, let me know!

-AS



Private Sub vInbox_ItemAdd(ByVal Item As Object)
If TypeName(Item) <> "MailItem" Then Exit Sub
Dim RegEx As Object, vFF As Long, vFile As String, vBody As String

'Set the output CSV file location here
vFile = "C:\savem2e.txt"
vBody = Item.Body
Set RegEx = CreateObject("vbscript.regexp")
With RegEx
.IgnoreCase = True
.Multiline = True
.Pattern = "Name:([^\n\r]*)[\n\r]*Telephone:([^\n\r]*)[\n\r]*Asks for:([^\n\r]*)"
End With
If RegEx.Test(vBody) Then
vFF = FreeFile
Open vFile For Output As #vFF
Print #vFF, vBody
Close #vFF
'Open vFile For Append As #vFF
'With RegEx.Execute(vBody).Item(0)
' Print #vFF, Trim(.SubMatches(0)) & "," & Trim(.SubMatches(1)) & "," & _
' Trim(.SubMatches(2))
'End With
'Close #vFF
Item.UnRead = False 'Mark As Read
End If
Set RegEx = Nothing
End Sub
[vba]

[andysuth]

....Saves entire body of email without alerting the guard, forgot to say that one important piece of info!

Cheers,

-Andy.

[andysuth]

....still looks for the name: Telephone: Asks for:, though, so I'll keep working on it until it just accepts the trigger words and then saves the parameters.

-AS

[andysuth]

Now I've modified your code to take the conditional "If/endif" statements out.

I'll have a play with this and hopefully unveil the new code next week.

Thanks for your help Matt.

-Andy.


Option Explicit
Dim WithEvents vInbox As Items
Private Sub Application_Startup()
Set vInbox = Application.Session.GetDefaultFolder(olFolderInbox).Items
Call CheckInbox
End Sub
Private Sub Application_NewMail()
If vInbox Is Nothing Then
Set vInbox = Application.Session.GetDefaultFolder(olFolderInbox).Items
Call CheckInbox
End If
End Sub
Private Sub Application_Quit()
Set vInbox = Nothing
End Sub
Function CheckInbox() As Boolean
Dim vItems As Object, vItem As Object
Set vItems = Application.Session.GetDefaultFolder(olFolderInbox).Items
For Each vItem In vItems
If TypeName(vItem) = "MailItem" Then
If vItem.UnRead = True Then
Call vInbox_ItemAdd(vItem)
End If
End If
Next
Set vItem = Nothing
Set vItems = Nothing
End Function
Private Sub vInbox_ItemAdd(ByVal Item As Object)
If TypeName(Item) <> "MailItem" Then Exit Sub
Dim RegEx As Object, vFF As Long, vFile As String, vBody As String
'Set the output Txt file location here
vFile = "C:\paramsy.txt"
vBody = Item.Body
vFF = FreeFile
Open vFile For Output As #vFF
Print #vFF, vBody
Close #vFF
Item.UnRead = False 'Mark As Read
Set RegEx = Nothing
End Sub
[VBA]

[mvidas]

Interesting.. I wonder why getting the .Body in one method triggers security but the other doesn't? Good to know at least.. maybe its the fact that it is an event? I'll have to take a closer look as to why..

As for the sub, it will save every message to a text file, not just the ones with the certain subject (though you can use something like 'If Item.Subject = "AutoStair" Then'). But you can remove the RegEx references:Private Sub vInbox_ItemAdd(ByVal Item As Object)
If TypeName(Item) <> "MailItem" Then Exit Sub
Dim vFF As Long, vFile As String, vBody As String

'Set the output CSV file location here
vFile = "C:\savem2e.txt"
vBody = Item.Body
vFF = FreeFile
Open vFile For Output As #vFF
Print #vFF, vBody
Close #vFF

Item.UnRead = False 'Mark As Read
End Sub
Just about anything can be done from VBA, so if you want to run the batch file too or anything just ask and I can show you how

[andysuth]

I'm calling the command line directly from the VB using "Shell" command.



ChDir "C:\ProE_files\workingmodel\"
Shell "C:\ProEng3\Wildfire3\bin\proe.exe -g:no_graphics C:\ProE_files\workingmodel\interactiveabsentee.txt", vbNormalFocus



Which I butchered from an Excel Program for ProE someone had written. (Edwin Muirhead, at Weatherfield, as published on Eng Tips ProE FAQ).

shell "[Dos Command]", vbNormalFocus

should all be on one line, and [dos command] can be anything you'd type at the command prompt (I believe).

The actual command I'm calling here is for starting ProEngineer without showing anything on screen (works faster, the "-g:no_graphics" switch) and then the name and location of the TRAIL file, which is a macro recorded in ProE and saved as a text file.

We won't go too deeply into the ProE Trail file, as basically it can do anything you want it to do in the industry standard solid modelling package, but it loads a set of parameters into the model and spits out a PDF, which is then sent out using Outlook to the recipients I want to receive it.

n.b. "Shell" means two different things in VB and in ProE, but if you're attempting this in ProE, you should know that by now!!!

If anyone reading this needs tips about ProE and MS Office Digital intergration, or other ProE automation stuff, give me a shout (reply to this message, it should alert me via email).

Thanks for your help Matt, I'll leave credit where due in the code!:)

Next step will be so it works from a text message (SMS) from a basic mobile phone, though I'm not sure I'm so enthusiastic about that!

-AS

[andysuth]

I'll post relevant sections of the code here when it's finalised.

I'll close thread then.

-AS

[mvidas]

No need for credit on my part, keep it in there and get some good credit yourself at work :)

Not sure how long it takes for your PDF to generate, but there is a different kind of shell available to you as well in VBA, that does the same as VB's but also has a 3rd (optional) argument called "Wait On Return". Accepts true or false (default), if you put True in there it will wait until the called line is done running before proceeding in code. Dim WShell As Object
Set WShell = CreateObject("wscript.shell")
WShell.Run "Dos Command", "[WindowStyle]", "[WaitOnReturn]"If you set a reference to Windows Scripting Host Object Library you could substitute "IWshRuntimeLibrary.WshShell" for "Object" above to see the intellisense; I just use late binding like above as its easier for distribution.


As for SMS.... good luck! Heh.. In my opinion it is 100 times easier to find out the email address equivalent for the phone you want to send it to than to deal with SMS. It will work just as well and you won't have to hook up any special hardware or anything

[andysuth]

SMS was just an idea because I could send it from my standard mobile phone with the inclusive texting, rather than the dang.berry or XDA. But I suppose there's a limited amount of actions that could be performed from that, the phone couldn't receive a PDF, so no point.

Time taken to run the PDF creation Trail file varies (depends on whether it's the first time ProE has been run after boot up, background processes, etc), and then it seems to run in the background, so I'm not sure it will trigger any kind of return, but I'll give it a go.

-AS

[andysuth]

Matt,

I've hit another (minor) problem. Currently the program excerpt above will save a text file, to all intents and purposes identical to the original text file, but if it is sent in any format other than "Plain Text" it'll trip over in ProE.

The two files look identical, but one is using spaces with a Hex-Dec code of "20" and one is using spaces with a Hex-Dec code of "A0".

Any ideas on how to amend the function above so that it will save as a Text File from "Plain Text" (suspect the difference in spaces is due to the HTML or Rich Text being used)?

Cheers,

-Andy.

[andysuth]

Currently, pretty it ain't, but it's alive!

I've got a very hairy routine for a delay (need to do something like:

Do Until Exist = "c:\output.pdf"
loop
-THAT'S NOT REAL CODE-

Anyone know any way of locking Outlook into a loop until an output file exists on a local hard drive?


But it now runs software on my PC as driven by a SPV M3100 PDAPhone.

And sends an email out with a PDF generated by the ProE Trail file.

-AS

[andysuth]

OK, that wasn't real code, to see if a file existed which I was generating.

As previously mentioned ProE can take a while to churn out a PDF file, so I have to wait until this is done. I have used a time delay to do this:

(in main sub)
fnWait(120)
(at end of main sub)

Public Function fnWait(intNrOfSeconds As Integer)
Dim varStart As Variant
varStart = Timer
Do While Timer < varStart + intNrOfSeconds
Loop
End Function


This was unfortunate, as I had to leave the Outlook Frozen in sleep mode for a long enough period that it would definately have the PDF generated.

I now use this short line of code to make sure the file exists:

Dim PDFname As String

PDFname = "C:\ProE\stell_ga.pdf"

Do
Loop Until Dir(PDFname, vbNormal) <> ""

item.Attachments.Add (PDFname)
item.Attachments.Add ("C:\ProE\stl_param.txt")



It hits a Do Loop and stays there until the DIR command finds something matching the filename of the PDF that ProE is generating.

Then it will email me the results. I'm sorry but this code is still incomplete, as I'm still in there and it's very messy, but I thought this method of waiting until a file has been generated would help someone.

It might be better to have a ten second pause in the routine so the disc interface card isn't constently interrogating the same directory whilst you're trying to write a PDF to it, this could be done by combining the two routines.

-AS

[mvidas]

Re: different types of spaces
I was going to say use .Body instead of .HTMLBody, but it looks like you already use .Body. What you could do is replace the "bad" spaces with the normal ones:'vBody = Item.Body
vBody = Replace(Item.Body, Chr(160), Chr(32))


Instead of using the Wait method like you're doing (even if you do use that, put "DoEvents" in the loop, or call the Sleep API), what you could do is use Wscript.Shell's Run method (see post #20 above), and use True in the WaitOnReturn to wait for the called command to complete.

[andysuth]

Nice use of replace, it works, thanks.

Overall system works, if I only do one set of parameters each time (until I return to my desk)

I've got a little algorythm I'm working on for file management, then I should be ready to run.

I'm tempted to even splash out some of the IT budget on a cheap PC (low spec, not even with a CAD - spec graphics card) and have it running 24/7 on that.......

-AS

[andysuth]

For what it's worth, full coded examples.

Email addresses, Paths, and Activation words have been changed to protect the innocent, for example where I say P3 is actually ProE3.....

.....(Dan Ackroyd Joke, sorry!)


Option Explicit
Dim WithEvents vInbox As Items
Private Sub Application_Startup()
Set vInbox = Application.Session.GetDefaultFolder(olFolderInbox).Items
Call CheckInbox
End Sub
Private Sub Application_NewMail()
If vInbox Is Nothing Then
Set vInbox = Application.Session.GetDefaultFolder(olFolderInbox).Items
Call CheckInbox
End If
End Sub
Sub filepause(attachname As String)
Dim varStrt As Variant
Do
varStrt = Timer
Do While Timer < varStrt + 10
Loop
Loop Until Dir(attachname, vbNormal) <> ""
End Sub
Sub SendAMessage(ByVal toname As String, attach1 As String, verint As Integer)
Dim ns As NameSpace, attach2 As String, msg As MailItem
' Set up the namespace
Set ns = ThisOutlookSession.Session

attach2 = "C:\P3\files\" & verint & "_swell_ga.pdf"

Call filepause(attach2)

Set msg = Application.CreateItem(olMailItem)
With msg
.Recipients.Add "id2m@as.com"
.Recipients.Add toname
.Subject = "Your AutoGen Drawing"
.Body = "This is your autogenerated drawing" & vbCrLf & "It's saved as file " & verint & vbCrLf & "I hope this is what you wanted....." & vbCrLf & "-AutoGen by id2m"
.Attachments.Add (attach1)
.Attachments.Add (attach2)
.Send
End With
End Sub
Function findversion(pathstring As String, filestring As String, verint As Integer)
Dim vPath As String
If Dir(pathstring & verint & filestring, vbNormal) <> "" Then
Do
verint = verint + 1
vPath = pathstring & verint & filestring
Loop Until Dir(vPath, vbNormal) = ""
End If
findversion = verint
End Function

Public Function fnWait(intNrOfSeconds As Integer)
Dim varStart As Variant
varStart = Timer
Do While Timer < varStart + intNrOfSeconds
Loop
End Function
Private Sub Application_Quit()
Set vInbox = Nothing
End Sub
Function CheckInbox() As Boolean
Dim vItems As Object, vItem As Object
Set vItems = Application.Session.GetDefaultFolder(olFolderInbox).Items
For Each vItem In vItems
If TypeName(vItem) = "MailItem" Then
If vItem.UnRead = True Then
Call vInbox_ItemAdd(vItem)
End If
End If
Next
Set vItem = Nothing
Set vItems = Nothing
End Function
Sub filerewriter(pthstg As String, verint As Integer, flnm As String)
Dim VFF As Long, vNIStep As String, vOIStep As String, vBody As String, vIStep As String
vNIStep = pthstg & verint & "_" & flnm
vOIStep = pthstg & flnm

VFF = FreeFile
Open vOIStep For Binary As #VFF
vBody = Space$(LOF(VFF))
Get #VFF, , vBody
Close #VFF
vIStep = Replace(vBody, "1001", verint)
Open vNIStep For Output As #VFF
Print #VFF, vIStep
Close #VFF

End Sub
Private Sub vInbox_ItemAdd(ByVal Item As Object)
Dim pathstring As String, versionint As Integer, VFF As Long, vParam As String
Dim vNIStep As String, vFlnm As String, PDFname As String, vBody As String

If TypeName(Item) <> "MailItem" Then Exit Sub
If Item.Subject <> "AutoOut" Then Exit Sub

pathstring = "C:\P3\files\"
vFlnm = "intereps.txt"
' findversion function call! Then Rewrite Trail Files!
versionint = findversion(pathstring, "_swell_param.txt", 1000)
Call filerewriter(pathstring, versionint, vFlnm)
vParam = pathstring & versionint & "_swell_param.txt"
vNIStep = pathstring & versionint & "_" & vFlnm
Item.BodyFormat = olFormatPlain
vBody = Replace(Item.Body, Chr(160), Chr(32))
VFF = FreeFile
Open vParam For Output As #VFF
Print #VFF, vBody
Close #VFF
Item.UnRead = False 'Mark As Read
ChDir pathstring
' needs a -If Exist- clause, can't be bothered though
' Shell "del trail*.*", vbNormalNoFocus
Shell "C:\P3\proe.exe -g:no_graphics " & vNIStep, vbNormalFocus
'-g:no_graphics makes ProE run faster (if no operator is required) as there is no graphics calculations.

Call SendAMessage(Item.SenderEmailAddress, vParam, versionint)

End Sub

Thanks for all the help I've had with this one.

Remember you need to write a trail file and save it somewhere appropriate and have it modify a model to suit.

I have changed a few of the names etc. as I entered this onto the internet, simply to suppliment security, but I might not have changed the file names or paths consistantly, so be aware there might be a few minor issues that need ironing out if you wish to use this program in a cut and paste way.

Might benefit from Global Variables too.

Now I'm in the mood for using a free download of SolidEdge 2D to a similar effect. Please see my next posting for helping me with that.

Thanks once again,

-Andy

macro <at> andysouthern <dot> com