• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Tekst uit mail in een tabel plaatsen

Status
Niet open voor verdere reacties.
Andre175

Andre175

Gebruiker
Lid geworden
2 feb 2018
Berichten
351
Hallo.

Ik krijg iedere week een mail met de actuele dieselprijzen.
Deze wil ik in een tabel zetten zodat het verloop in prijzen duidelijk zichtbaar wordt.

In het onderwerp van de mail staat om welke week het gaat.

Onderwerp: The Fuel Company | Prijzen week 05

De tekst staat gewoon in de body van de mail en ziet er als volgt uit:

Geachte heer,

Officiële prijzen

België - Zone 1A
€ 1,5050 (inclusief 21% BTW)
Af 21% BTW € 0,2612
Af korting € 0,1150
Af accijns € 0,2476158 (achteraf terug te vorderen)
Netto per liter diesel is € 0,8812

Nederland - Zone 1
€ 1,4291 (inclusief 21% BTW)
Af 21% BTW € 0,2481
Af korting € 0,0980
Netto per liter diesel is € 1,0830

Luxemburg - Zone 1
€ 1,0660 (inclusief 17% BTW)
Af 17% BTW € 0,1549
Af korting € 0,0200
Netto per liter diesel is € 0,8911



Is het mogelijk om via een macro de gegevens automatisch in een tabel te zetten?
Nog mooier zou zijn, dat zodra de mail binnenkomt in outlook, de gegevens automatisch verwerkt worden.
De mail komt binnen in een submap van Postvak in, hier komen alleen deze mails in mbt de brandstofprijzen.

Bekijk bijlage Brandstofprijzen.xlsb

André
 
Bedankt voor de link....

Ondertussen had ik ook al iets anders gevonden waar ik kort mee aan het "stoeien" ben geweest.
Deze code draait vanuit Outlook ipv vanuit Excel

Code: 
Sub Pijzen_lezen()
   With GetObject("D:\onedrive\4 Andre\Excel VBA\brandstof\test.xlsx")
        For Each it In GetNamespace("MAPI").GetDefaultFolder(6).Folders("prijzen").Items
           sn = Split(Split(it.Body, "Offerrerequest")(1), vbCrLf)
           .Sheets("Blad1").Cells(1, 2).Resize(UBound(sn) + 1) = .Application.Transpose(sn)
        Next
    End With
 End Sub

Loop vast op het kiezen van de juiste map.....

GetDefaultFolder(6) is Postvak in heb ik begrepen.

Hoe kom ik nu in de map: Postvak in\Crediteuren\The Fual Company\prijzen?
 
Laatst bewerkt:
Schrijf het eens voluit in de plaats van de 6.

Code: 
For Each it In GetNamespace("MAPI").GetDefaultFolder([COLOR=#ff0000]"[I]Postvak in\Crediteuren\The Fual Company\prijzen?"[/I][/COLOR]).Folders("prijzen").Items

Geen idee; ik heb het niet getest.
 
@ HSV

fout 13 tijdens uitvoering
Typen komen niet met elkaar overeen

ff snel geprobeerd, andere keer verder.

nu welterusten.... ;)
 
Goedemorgen.

Op de site die cow18 in #5 aangaf vond ik de volgende code, deze geeft een keurig overzicht van de Outlook mappenstruktuur:

Code: 
Sub mappen_Outlookmappenstruktuur()
For Each fld In CreateObject("Outlook.Application").GetNamespace("MAPI").Folders
c01 = c01 & vbCr & vbCr & fld.Name & "|" & fld.Folders.Count & "|" & fld.Items.Count

For Each fld1 In fld.Folders
c01 = c01 & vbCr & "|" & fld1.Name & "|" & fld1.Folders.Count & "|" & fld1.Items.Count

For Each fld2 In fld1.Folders
c01 = c01 & vbCr & "||" & fld2.Name & "|" & fld2.Folders.Count & "|" & fld2.Items.Count

For Each fld3 In fld2.Folders
c01 = c01 & vbCr & "|||" & fld3.Name & "|" & fld3.Folders.Count & "|" & fld3.Items.Count
Next
Next
Next
Next

Sheets("Blad2").Cells(1).Resize(UBound(Split(c01, vbCr)) - 1) = Application.Transpose(Split(Mid(c01, 3), vbCr))
Sheets("Blad2").Columns(1).TextToColumns , 1, -4142, , False, False, False, False, True, "|"
End Sub

nu wil ik deze uitbreiden naar 4 nivo's...

Code: 
Sub mappen_Outlookmappenstruktuur()
    For Each fld In CreateObject("Outlook.Application").GetNamespace("MAPI").Folders
    c01 = c01 & vbCr & vbCr & fld.Name & "|" & fld.Folders.Count & "|" & fld.Items.Count
    
        For Each fld1 In fld.Folders
        c01 = c01 & vbCr & "|" & fld1.Name & "|" & fld1.Folders.Count & "|" & fld1.Items.Count
        
            For Each fld2 In fld1.Folders
            c01 = c01 & vbCr & "||" & fld2.Name & "|" & fld2.Folders.Count & "|" & fld2.Items.Count
            
                For Each fld3 In fld2.Folders
                c01 = c01 & vbCr & "|||" & fld3.Name & "|" & fld3.Folders.Count & "|" & fld3.Items.Count
                
                    [COLOR="#FF0000"]For Each fld4 In fld3.Folders
                    c01 = c01 & vbCr & "||||" & fld4.Name & "|" & fld4.Folders.Count & "|" & fld4.Items.Count
                    Next[/COLOR]
                Next
            Next
        Next
    Next

Sheets("Blad2").Cells(1).Resize(UBound(Split(c01, vbCr)) - 1) = Application.Transpose(Split(Mid(c01, [COLOR="#FF0000"]4[/COLOR]), vbCr))
Sheets("Blad2").Columns(1).TextToColumns , 1, -4142, , False, False, False, False, True, "|"
End Sub

het rode gedeelte heb ik aangepast, echter ik krijg niet het juiste resultaat.

de mappen op nivo 4 worden nog niet weergegeven.

wat doe ik fout?
 
Laatst bewerkt:
oeps.....

Vergeet mijn vraag in #7 maar..... ik keek niet goed naar het resultaat.

ik ga verder met mijn oorspronkelijke vraag en probleem ;)
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan