Extract lines and print

[ekto]

Hi !

I need to do a Outlook VBA project. I have used about 8 hours of google and haven't got even started. Normally with Excel the thing would be done allready


Here is an image of the Email(revome the () around dots):
www(.)robokara(.)fi/images/image.jpg

I have marked what text I would like to extract from the mail.

This text would be printed out from a label printer like this:
Kari Nurmi
Tapiolantie 21 B18
60150 SEINÄJOKI

I can set the label printer as a default printer for that PC, so I think that just a normal print command would do.

I have made a rule that regognices these mails and forwards them to right persons. The same rule also runs a patch that start our Disc Bublisher wich will make a DVD. The same rule should run the Script that prints the label.

Things I need help with:
How to make a VBA that finds nimi: from the Body-element and get's the rest of the line to an integer.

Could you guys help me?

[Charlize]

[vba]Sub Print_Label()
Dim MyPath As String, MyFile As String, Fileno As Long
Dim MyName As String, MyAdress As String, MyPlace As String
Dim TheResult As String
MyPath = "C:\"
Fileno = FreeFile
Open MyPath & "LabelAdress" & ".txt" For Output As #Fileno
'Mailmessage we are going to handle
Dim mymessage As Outlook.MailItem
'thebody = message, thesubject = subject, thedate = datevalue, strdate = stringdate
Dim thebody As String, thesubject As String, thedate As Date, strdate As String
'put mailmessage into mymessage. we use the active mailmessage in this example
Set mymessage = ActiveExplorer.Selection.Item(1)
'put body of message in thebody
thebody = mymessage.Body
'nimi:
'...
MyName = Mid(thebody, InStr(1, thebody, "nimi: ") + 6, _
InStr(InStr(1, thebody, "nimi: "), thebody, vbCrLf) - _
InStr(1, thebody, "nimi: ") - 6)
MyAdress = Mid(thebody, InStr(1, thebody, "osoite: ") + 8, _
InStr(InStr(1, thebody, "osoite: "), thebody, vbCrLf) - _
InStr(1, thebody, "osoite: ") - 8)
MyPlace = Mid(thebody, InStr(1, thebody, "postinro") + 9, _
InStr(InStr(1, thebody, "postinro"), thebody, vbCrLf) - _
InStr(1, thebody, "postinro") - 9)
MyPlace = MyPlace & " " & Mid(thebody, InStr(1, thebody, "kunta: ") + 7, _
InStr(InStr(1, thebody, "kunta: "), thebody, vbCrLf) - _
InStr(1, thebody, "kunta: ") - 7)
TheResult = MyName & vbCrLf & MyAdress & vbCrLf & Ucase(MyPlace)
Print #Fileno, TheResult
Close #Fileno
'You should alter the default options of notepad for printing
'You can change the margins to 10 mm, remove header and footer
'and take a bigger font to print.
'You need to do it with the file LabelAdress.txt when you open
'it manually in notepad. You can save your changes with this file.
Shell "NOTEPAD /P c:\LabelAdress.txt"
End Sub[/vba]Charlize

[ekto]

Thanks for the code!

What do I need to put here:
[vba]Sub Print Label (what to put here)[/vba]
I need to put something there or else it will not show the VBA in the Rule dialog box?

Cheers!

[ekto]

I found this on the internet, but it didin't help:
[VBA]Sub Print Label (MyMail As MailItem)[/VBA]

I can now select it from the Run Script dialog when making a rule, but it only process mail, wich is higlighted at outlook. Example a mail that has been last viewed. It does not process new mail.

Is it the MyMail As MailItem that is causing it?

[Charlize]

Here the modified script so it would run with any new message that arrives. Another possibility would be by using withevents in the thisoutlooksession. This option works without any rules. You define a folder to watch for every new mail (inbox in this case) and use select case or if structure to determine what to do with a new message.

We are using mymessage as variable instead of mymail.

The reason why it would only work on the selected mail is ... because it was designed like this (1st version at least). Now it should work if you define your rule.

[VBA]Sub Print_Label(mymessage As Outlook.MailItem)
Dim MyPath As String, MyFile As String, Fileno As Long
Dim MyName As String, MyAdress As String, MyPlace As String
Dim TheResult As String
MyPath = "C:\"
Fileno = FreeFile
Open MyPath & "LabelAdress" & ".txt" For Output As #Fileno
'thebody = message from mail
Dim thebody As String
'put body of message in thebody
thebody = mymessage.Body
'nimi:
'...
MyName = Mid(thebody, InStr(1, thebody, "nimi: ") + 6, _
InStr(InStr(1, thebody, "nimi: "), thebody, vbCrLf) - _
InStr(1, thebody, "nimi: ") - 6)
MyAdress = Mid(thebody, InStr(1, thebody, "osoite: ") + 8, _
InStr(InStr(1, thebody, "osoite: "), thebody, vbCrLf) - _
InStr(1, thebody, "osoite: ") - 8)
MyPlace = Mid(thebody, InStr(1, thebody, "postinro") + 9, _
InStr(InStr(1, thebody, "postinro"), thebody, vbCrLf) - _
InStr(1, thebody, "postinro") - 9)
MyPlace = MyPlace & " " & Mid(thebody, InStr(1, thebody, "kunta: ") + 7, _
InStr(InStr(1, thebody, "kunta: "), thebody, vbCrLf) - _
InStr(1, thebody, "kunta: ") - 7)
TheResult = MyName & vbCrLf & MyAdress & vbCrLf & UCase(MyPlace)
Print #Fileno, TheResult
Close #Fileno
'You should alter the default options of notepad for printing
'You can change the margins to 10 mm, remove header and footer
'and take a bigger font to print.
'You need to do it with the file LabelAdress.txt when you open
'it manually in notepad. You can save your changes with this file.
Shell "NOTEPAD /P c:\LabelAdress.txt"
End Sub
[/VBA]Charlize

[ekto]

Thanks, this seems to work

One more thing I would like to ask:

Sometimes there is a Yritys: field on these forms.
How do I add it so, that it will be printed only when it appears on the code?

I tried to add it but I get an error, Invalid Procedure call or argument
[vba]Sub Print_Label(mymessage As Outlook.MailItem)
Dim MyPath As String, MyFile As String, Fileno As Long
Dim MyName As String, MyCompany As String, MyAdress As String, MyPlace As String
Dim TheResult As String
MyPath = "C:\0\"
Fileno = FreeFile
Open MyPath & "LabelAdress" & ".txt" For Output As #Fileno
'thebody = message from mail
Dim thebody As String
'put body of message in thebody
thebody = mymessage.Body
'nimi:
'...
MyName = Mid(thebody, InStr(1, thebody, "nimi: ") + 6, _
InStr(InStr(1, thebody, "nimi: "), thebody, vbCrLf) - _
InStr(1, thebody, "nimi: ") - 6)
MyCompany = Mid(thebody, InStr(1, thebody, "Yritys: ") + 8, _
InStr(InStr(1, thebody, "Yritys: "), thebody, vbCrLf) - _
InStr(1, thebody, "Yritys: ") - 8)
MyAdress = Mid(thebody, InStr(1, thebody, "osoite: ") + 8, _
InStr(InStr(1, thebody, "osoite: "), thebody, vbCrLf) - _
InStr(1, thebody, "osoite: ") - 8)
MyPlace = Mid(thebody, InStr(1, thebody, "postinro") + 10, _
InStr(InStr(1, thebody, "postinro"), thebody, vbCrLf) - _
InStr(1, thebody, "postinro") - 10)
MyPlace = MyPlace & " " & Mid(thebody, InStr(1, thebody, "kunta: ") + 7, _
InStr(InStr(1, thebody, "kunta: "), thebody, vbCrLf) - _
InStr(1, thebody, "kunta: ") - 7)
TheResult = MyName & vbCrLf & MyCompany & vbCrLf & MyAdress & vbCrLf & UCase(MyPlace)
Print #Fileno, TheResult
Close #Fileno
'You should alter the default options of notepad for printing
'You can change the margins to 10 mm, remove header and footer
'and take a bigger font to print.
'You need to do it with the file LabelAdress.txt when you open
'it manually in notepad. You can save your changes with this file.
'Shell "NOTEPAD /P c:\0\LabelAdress.txt"
End Sub
[/vba]

I changed the postinro to 10, so there will not be an empty space at the line.
The Shell command is a comment at this point, so I can test this with out using expensive labes.

[ekto]

It was because the Yritys was writen with capital Y. It works now since I change it to y.

Now it crashes, if there is no yritys, on the form. I need a statement?