[VBA] Regels uitlezen uit Item.Body

[Hermanvh]

Ik probeer een work-around te verzinnen voor het volgende:

Wij hebben een groot aantal bestanden (kopiefacturen) staan op een lokale network-share die alleen vanuit de Benelux toegankelijk is. Deze bestanden staan geïndexeerd in een webbased (ASP 3.0) tool.

Echter vanuit de States en andere landen wenst men ook toegang te hebben tot deze bestanden.

Om e.e.a. te realiseren heb ik een redelijk smerige (maar effectieve) work-around bedacht die ook al geruime tijd prima werkt:

Vanuit de ASP pagina wordt er een email gestuurd met het onderwerp "701913739 Copy Invoice" met in de body de locatie van de kopiefactuur (bijv. " k:\Billing_CoE_Northern_Europe\NL\Invoices\Exact\27800476.pdf"). Deze mail komt binnen op een lokale machine die deze vervolgens verwerkt en eigenlijk een reply terugstuurt met het bestand dat in de body van de mail genoemd wordt

Het enige probleem is, dat dit per bestand gaat. Wanneer ik dus voor 1 klant 10 facturen zou willen opvragen op deze manier, moet dat met 10 mailtjes.

Het lijkt mij dat het zou kunnen om bijv. de Item.Body regel voor regel uit te lezen en dan meerdere attachments toe te voegen, echter ik kan maar niet vinden hoe ik dit zou moeten realiseren

Hieronder de code die ik op dit moment gebruik.

Iemand suggesties?

code:

Public WithEvents myOlItems As Outlook.Items
 
Public Sub Application_Startup()
Set myOlItems = Outlook.Session.GetDefaultFolder(olFolderInbox).Items
End Sub
 
 
 
 

Private Sub myOlItems_ItemAdd(ByVal Item As Object)
    If Left(Item.Subject, 22) = "701913739 Copy Invoice" Then
 
        Dim AttName As String
        Dim myInbox As MAPIFolder
        Dim myOlApp As Application
        Dim myNameSpace As NameSpace
        Set myOlApp = CreateObject("Outlook.Application")
        Set myNameSpace = myOlApp.GetNamespace("MAPI")
        Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
        AttName = Item.Body
        AttName = RTrim(AttName)
        AttName = LTrim(AttName)
        Dim strFileName As String
        strFileName = GetNameFromPath(AttName)
        Invoice = Left(strFileName, Len(strFileName) - 4)
            If Item.UnRead = True Then
                Item.UnRead = False
            End If
            
            If TypeName(Item) = "MailItem" Then
            Set MyReply = Item.Reply
            
                If ((Left(AttName, 3) = "K:\") Or (Left(AttName, 3) = "k:")) Then
                On Error Resume Next
                       MyReply.Attachments.Add AttName, olByValue, , _
                    "Attachment"
                
                        If Err.Number = 0 Then
                            MyReply.Subject = "Your requested copy invoice: " + Invoice + " is attached"
                            MyReply.Body = ""
                            MyReply.Send
                            Item.Move (myInbox.Folders("Sent Copy Invoices"))
                        Else
                            MyReply.Body = "Sorry your copy invoice could not be send at this time. We will try to send you the requested copy invoice within 1 working day. You don't need to request it again!"
                            MyReply.Subject = "There was a problem sending your copy invoice " + Invoice
                            MyReply.Send
                        End If
                Else
                    MyReply.Subject = "You requested an illegal action"
                    MyReply.Send
                    Item.Move (myInbox.Folders("Sent Copy Invoices"))
                End If
    
        End If
            
    End If
     
End Sub

[Hermanvh]

Een aardig eindje opgelost met wat work-arounds, maar het doet zijn werk nu prima Nog een paar cosmetische verbeteringen toevoegen, maar dat is dan ook alles. Hieronder de oplossing.

De mail die gestuurd wordt heeft het volgende formaat:

Subject: "701913739 Copy Invoice"
V.b. van de body: "K:\Billing_CoE_Northern_Europe\NL\Invoices\Data\Geneva (new)\Geneva 2006\26003146.pdf**K:\Billing_CoE_Northern_Europe\NL\Invoices\Data\Geneva (new)\Geneva 2006\26003575.pdf**K:\Billing_CoE_Northern_Europe\NL\Invoices\Data\Geneva (new)\Geneva 2007\26003974.pdf**"

Visual Basic:

Private Sub myOlItems_ItemAdd(ByVal Item As Object)
    'Only process emails with the specified subject
    If Left(Item.Subject, 22) = "701913739 Copy Invoice" Then
 
        'Declare some variables
        Dim AttName As String
        Dim myInbox As MAPIFolder
        Dim myOlApp As Application
        Dim myNameSpace As NameSpace
        Dim x As Variant
        Dim i As Long
        Dim y As String
        
        Set myOlApp = CreateObject("Outlook.Application")
        Set myNameSpace = myOlApp.GetNamespace("MAPI")
        Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
        
        
        If (Item.UnRead = True) Then
            Item.UnRead = False
        End If
            
        If TypeName(Item) = "MailItem" Then
        Set MyReply = Item.Reply
            
        'Read the body of the email into the AttName variable and trim it from unnecessary spaces.
        AttName = Item.Body
        AttName = RTrim(AttName)
        AttName = LTrim(AttName)
                
        
        'Split AttName into array x, filenames in AttName are seperated by a double astrerix (**)
        x = Split(AttName, "**")
    
            'Check if the body of the email starts with K:\ since the copy invoice is always the first file to be requested and should always be on K:\
            If ((Left(AttName, 3) = "K:\") Or (Left(AttName, 3) = "k:\")) Then
            'Count the number of items in the X array
            j = UBound(x)
            'The email contains a hard enter (CR LF (0D 0A)) at the end, therefore the last item in the X array shouldn't be used and 1 is deducted.
            j = j - 1
            'In order to modify the subject, add an additional counter :)
            k = j - 1
            'If only 1 file is in the array, use subject for single invoice
            If (j = 0) Then
                MyReply.Subject = "Your requested copy invoice: "
                'In case of multiple files, adjust subject accordingly.
            Else
                MyReply.Subject = "Your requested copy invoices: "
            End If
            
            For i = 0 To j
                'Loop through the array and add the attachments 1 by one after some cleanup is done.
                y = LTrim(x(i))
                y = RTrim(y)
                y = Replace(y, "**", "")
                'Determine the invoicenumber (only works correct for 8-digit invoice numbers now)
                strFileName = Left(Right(y, 12), 8)
                Invoice = strFileName
                Extension = Right(y, 4)
            
                On Error Resume Next
                'Add attachment
                MyReply.Attachments.Add (y), olByValue, , _
                "Attachment"
                            
                'Logics for manipulating email subject. Case extension of file is PDF, append invoice number to the subject. Depending on number of invoices requested choose the appropriate subject
                If (Extension = ".pdf") Then
                    If (j = 0) Then
                        MyReply.Subject = MyReply.Subject + Invoice + " is attached"
                    Else
                        If ((i <> j) And (i <> k)) Then
                            MyReply.Subject = MyReply.Subject + Invoice + ", "
                        ElseIf (i = k) Then
                            MyReply.Subject = MyReply.Subject + Invoice + " and "
                        ElseIf (i = j) Then
                            MyReply.Subject = MyReply.Subject + Invoice + " are attached"
                        End If
                    End If
                End If
            'Move to next item in Array
            Next i
                
            'Case no error occurred, clear the message body, send the email and move the original email to "Sent Copy Invoices" folder
            If Err.Number = 0 Then
                MyReply.Body = ""
                MyReply.Send
                Item.Move (myInbox.Folders("Sent Copy Invoices"))
            Else
                MyReply.Body = "Sorry your copy invoice could not be send at this time. We will try to send you the requested copy invoice within 1 working day. You don't need to request it again!"
                'MyReply.Subject = "There was a problem sending your copy invoice " + Invoice
                MyReply.Send
            End If
        Else
            MyReply.Subject = "You requested an illegal action"
            MyReply.Send
            Item.Move (myInbox.Folders("Sent Copy Invoices"))
        End If
    End If
End If

End Sub

[ Voor 3% gewijzigd door Hermanvh op 16-05-2007 13:20 ]

[NMe]

Waar hoort mijn topic?

PRG>>OFF