Consulting

Results 1 to 13 of 13

Thread: Extract lines and print

  1. #1
    VBAX Regular
    Joined
    Mar 2012
    Posts
    10
    Location

    Extract lines and print

    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?

  2. #2
    VBAX Master
    Joined
    Jul 2006
    Location
    Belgium
    Posts
    1,286
    Location
    [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

  3. #3
    VBAX Regular
    Joined
    Mar 2012
    Posts
    10
    Location
    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!

  4. #4
    VBAX Regular
    Joined
    Mar 2012
    Posts
    10
    Location
    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?

  5. #5
    VBAX Master
    Joined
    Jul 2006
    Location
    Belgium
    Posts
    1,286
    Location
    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

  6. #6
    VBAX Regular
    Joined
    Mar 2012
    Posts
    10
    Location
    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.

  7. #7
    VBAX Regular
    Joined
    Mar 2012
    Posts
    10
    Location
    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?

  8. #8
    VBAX Master
    Joined
    Jul 2006
    Location
    Belgium
    Posts
    1,286
    Location
    [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]

  9. #9
    VBAX Regular
    Joined
    Mar 2012
    Posts
    10
    Location
    It now runs regardless if Yritys has anything, but it wont print the Yritys.

    So if there is nothing on it, or if there is, the label is the same.

    Edit: I moved the Yritys to rigth place:
    [VBA]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 & MyYritys & vbCrLf & MyAdress & vbCrLf & UCase(MyPlace)
    Else
    'Address without Yritys
    TheResult = MyName & vbCrLf & MyAdress & vbCrLf & UCase(MyPlace)
    End If[/VBA]

  10. #10
    VBAX Master
    Joined
    Jul 2006
    Location
    Belgium
    Posts
    1,286
    Location
    Dear Ekto,

    Watch the capital letters. You said yourself that it needed to search for yritys ...

    Charlize

  11. #11
    VBAX Regular
    Joined
    Mar 2012
    Posts
    10
    Location
    Yes, thanks! Now it works!

    Do you know if there is different types of vbCrLf?
    I think that the printer is not neceserly realyzing that. We had similar problem with one PHP system...
    Last edited by ekto; 03-09-2012 at 02:48 AM.

  12. #12
    VBAX Master
    Joined
    Jul 2006
    Location
    Belgium
    Posts
    1,286
    Location
    [VBA]vbcrlf[/VBA]is enter with a line feed I think. Instead of that, you could use [VBA]chr$(13)[/VBA] for enter and if I'm not mistaken, [VBA]chr$(10)[/VBA] for the linefeed. But I'm not an expert on that. If it works ... don't break it .

    Charlize

  13. #13
    VBAX Regular
    Joined
    Mar 2012
    Posts
    10
    Location
    I got it working by installing newer version of the printer software. Thanks Charlize, you have been a real help.

    One more quoestion,

    Since Outlook is running on a PC wich is not used normally, I would like to add some error handling to the code. It would be nice, that if there is an error, it would just jump over that mail, and try the next.

    I tried to use On error GoTo, but I didn't sucseed.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •