Email Body veranderd na forward

[Roeland035]

Beste forumleden,

Ik heb een macro dat gegevens van een email body automatisch exporteert naar een Excel bestand.
Hij pakt specifieke informatie uit deze body door middel van de filter en split functie.

Het rare is dat de email.body van formaat veranderd zodra hij doorgestuurd wordt.
Zodra een mailtje doorgestuurd is, dan werkt mijn macro wel doordat hij elk stukje van het tabel in een aparte regel zet.
Zodra het om het origineel gaat, dan pakt hij zowel de linker als de rechterkant van het tabel uit de body en zet het in één regel.


Doorgestuurd (debug.print van de body):

Company Name: 

Test

Origineel (debug.print van de body):

Company Name:   Test

Is er een mogelijkheid om de body altijd als doorgestuurd te laten beschouwen? Ondanks of het nou wel of niet een doorgestuurd mailtje omvat?

 

[snb]

Waarom zoveel taalfouten in 1 bericht + titel (bijv. verandert, de tabel)

Waarom de code die de mail produceert niet geplaatst?

 

[Roeland035]

Taalfouten:
Ik zou erg graag een cursus Nederlands bij je willen volgen, maar ik steek liever mijn tijd in de code.
Daarnaast val ik liever ook niet in herhaling met ons akkefietje van twee jaar geleden.

Forumvraag:
De tabel wordt door een webformulier gegenereerd en ik heb alleen maar toegang tot het resultaat (mail in inbox). Vandaar dat ik alleen het resultaat kan posten. Zover ik weet heb ik alleen maar een nieuw stukje code nodig om de body dusdanig te transponeren zodat het volgende:

Minimum product weight:     .4 kg   
Maximum product weight:     1 kg    
Product in feed height:     900 mm  
Product out feed height:    2400 mm

er uit komt te zien als:

Minimum product weight: 

.4 kg 

Maximum product weight: 

1 kg 

Product in feed height: 

900 mm 

Product out feed height: 

2400 mm

Iemand enig idee?

 

[edmoor]

Plaats je document eens met de code en de gegevens voor de mail erin.

 

[Roeland035]

Public conveyor As String

Sub Search_Conveyor()

Dim currentExplorer As Explorer
Dim Selection As Selection
Dim olItem As Outlook.MailItem
Dim sText As String

Set olItem = Application.ActiveExplorer().Selection(1)
sText = olItem.Body
      Set Reg1 = New RegExp
       
    With Reg1
        .Pattern = "Conveyor type:+\s*(\w*)"
        .Global = True
    End With
    
    If Reg1.Test(sText) Then
        Set M1 = Reg1.Execute(sText)
        For Each Match In M1
            If Match.SubMatches.Count > 0 Then
                For Each subMatch In Match.SubMatches
                    If subMatch = "mk1" Then
                        conveyor = subMatch
                        Call Prorunner_naar_configuratieblad
                        Exit Sub
                    ElseIf subMatch = "mk5" Then
                        conveyor = subMatch
                        Call Prorunner_naar_configuratieblad
                        Exit Sub
                    ElseIf subMatch = "mk9" Then
                        conveyor = subMatch
                        Call Prorunner_naar_configuratieblad
                        Exit Sub
                    ElseIf subMatch = "mk10" Then
                        conveyor = subMatch
                        Call Prorunner_naar_configuratieblad
                        Exit Sub
                    End If
                Next subMatch
            End If
        Next
    End If
NotFound:
    MsgBox ("Could not find a Salesquote." & vbCrLf & _
    "Did you select the correct email?" & vbCrLf & _
    vbCrLf & _
    "Current selected email: " & vbCrLf & _
    olItem)
End Sub

Sub Prorunner_naar_configuratieblad()

Dim currentExplorer As Explorer
Dim Selection As Selection
Dim olItem As Outlook.MailItem
Dim myPath As String
Dim myExt As String
Dim myFile As String
Dim Data1()
Dim i As Integer
Dim LDate As Date
Dim worksh As Integer
Dim worksheetexists As Boolean

worksheetexists = False

x = Null

myPath = "R:\PRORUNNER " & conveyor & "\Configuratieblad\"
myExt = "Specifications " & conveyor & "*.xlsx"
myFile = Dir(myPath & myExt)
If myFile = "" Then
    GoTo NotFound
End If

Set olItem = Application.ActiveExplorer().Selection(1)
    With GetObject(myPath & myFile)
        worksh = .Sheets.Count
        For y = 1 To worksh
            If .Worksheets(y).Name = "Email Data" Then
                worksheetexists = True
                Exit For
            End If
        Next y
        
        If worksheetexists = False Then
            MsgBox "The configurationfile for the " & conveyor & " does not support this action yet"
            Exit Sub
        End If
           
        LDate = olItem.ReceivedTime
        On Error GoTo NotFound1
           headers = Filter(Split(Split(olItem.Body, "Offerrequest Qimarox Vertical Conveyors")(1), vbCrLf), ": ", True)
           Data = Filter(Split(Split(olItem.Body, "Offerrequest Qimarox Vertical Conveyors")(1), vbCrLf), ": ", False)
                For Each x In Data
                    If Not x & "" = "" Then
                        ReDim Preserve Data1(i + 1)
                        Data1(i) = x
                        i = i + 1
                    End If
                Next
           .Sheets("Email Data").Cells(1, 1).Resize(UBound(headers) + 1) = .Application.Transpose(headers)
           .Sheets("Email Data").Cells(1, 2).Resize(UBound(Data1) + 1) = .Application.Transpose(Data1)
           .Sheets("Email Data").Range("B14:B15").Delete Shift:=xlUp
           .Sheets("Email Data").Range("B16").Delete Shift:=xlUp
           .Sheets("Email Data").Range("B1").Value = LDate
           .Sheets("General").Activate
       .Application.Visible = True
       .Windows(1).Visible = True
    End With
Exit Sub
NotFound:
    MsgBox ("Configuration sheet could not be found.")
Exit Sub
NotFound1:
    MsgBox ("Could not find the Salesquote." & vbCrLf & _
    "Did you select the correct email?" & vbCrLf & _
    vbCrLf & _
    "Current selected email: " & vbCrLf & _
    olItem)
 End Sub

Deze macro maakt een array van de headers en een array van de data uit de tabel van het mailtje. Helaas werkt dit alleen maar wanneer het mailtje doorgestuurd is. Zodra ik de body ook print om te testen komt hij er inderdaad anders uit te zien zodra hij niet doorgestuurd is.

Mailtje indien doorgestuurd: http://s000.tinyupload.com/?file_id=19568328413477443374
Mailtje indien niet doorgestuurd: http://s000.tinyupload.com/?file_id=00419418871670996920

Ik kon helaas geen .msg bestanden uploaden via het forum, dus vandaar dat ik tinyupload hiervoor gebruik.

 

[edmoor]

Het is zo uiteraard niet eenvoudig te volgen zonder de fysieke voorbeelden, maar je sloopt hier zelf die Cariage Return/LineFeeds eruit:

headers = Filter(Split(Split(olItem.Body, "Offerrequest Qimarox Vertical Conveyors")(1), vbCrLf), ": ", True)
Data = Filter(Split(Split(olItem.Body, "Offerrequest Qimarox Vertical Conveyors")(1), vbCrLf), ": ", False)

 

[Roeland035]

Ik moet toegeven dat ik niet geheel snap hoe die lijn precies in elkaar zit. Het gene wat ik graag zou willen hebben is dat er altijd een linebreak komt na elke dubbelepunt + spatie. (": ").

Ik heb al van alles en nog wat geprobeerd met die lijn om het werkende te krijgen, maar ook na uitgebreid de documentatie van de split en filter functie erbij te pakken kom ik er niet uit.

Momenteel pakt hij in het geval van een niet-doorgestuurd mailtje de volgende strings in de array:
. De bedoeling is dat hij "JR Automation" "Albert" "Vossler" niet in de string opneemt.