Excel Hints

Results 1 to 13 of 13

Thread: Extract lines and print

  1. #1

    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
    VB:
    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 
    
    
    Formatting tags added by mark007
    Charlize

  3. #3
    Thanks for the code!

    What do I need to put here:
    VB:
    Sub Print Label (what To put here) 
    
    
    Formatting tags added by mark007
    I need to put something there or else it will not show the VBA in the Rule dialog box?

    Cheers!

  4. #4
    I found this on the internet, but it didin't help:
    VB:
    Sub Print Label (MyMail As MailItem) 
    
    
    Formatting tags added by mark007
    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
    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.

    VB:
    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 
    
    
    Formatting tags added by mark007
    Charlize

  6. #6
    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
    VB:
    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 
    
    
    Formatting tags added by mark007
    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
    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
    VB:
    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 
    
    
    Formatting tags added by mark007

  9. #9
    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:
    VB:
    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 
    
    
    Formatting tags added by mark007

  10. #10
    Dear Ekto,

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

    Charlize

  11. #11
    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
    VB:
    vbcrlf 
    
    
    Formatting tags added by mark007
    is enter with a line feed I think. Instead of that, you could use
    VB:
    chr$(13) 
    
    
    Formatting tags added by mark007
    for enter and if I'm not mistaken,
    VB:
    chr$(10) 
    
    
    Formatting tags added by mark007
    for the linefeed. But I'm not an expert on that. If it works ... don't break it .

    Charlize

  13. #13
    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
  •