[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 MyYritys 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)
'Yritys: yes or no
'Search for the place where the word Yritys: occures
'If found, it will return the position (number) where it starts
'If not found, it will skip the part that extracts the word
'after the searchstring (Yritys
If InStr(1, thebody, "Yritys:") <> 0 Then
MyYritys = Mid(thebody, InStr(1, thebody, "Yritys: ") + 8, _
InStr(InStr(1, thebody, "Yritys: "), thebody, vbCrLf) - _
InStr(1, thebody, "Yritys: ") - 8)
'Added Yritys in between street and city
TheResult = MyName & vbCrLf & MyAdress & vbCrLf & MyYritys & vbCrLf & UCase(MyPlace)
Else
'Address without Yritys
TheResult = MyName & vbCrLf & MyAdress & vbCrLf & UCase(MyPlace)
End If
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]