Emailtekst naar kolommen

[antonvdijk]

Hoi allemaal,

ik vermoed haast dat deze vraag ooit eerder is gesteld, maar ik wist met geen zoekwoord op iets soortgelijks uit te komen dus bij deze alsnog een topic.
ik help iemand met een contactformulier op een website. deze gegevens wil hij graag opslaan in een Excel overzicht.
een verstuurd formulier op de website komt als volgt binnen via email:

De naam: Anton v. Dijk
telefoonnummer: 0612345678
het emailadres: geenbestaande@email.nl

het is verplicht om een naam in te vullen, maar één contactmogelijkheid hoeft maar ingevuld te zijn.
dus soms komt er een mailtje binnen met maar 2 regels zoals:

De naam: Anton v. Dijk
het emailadres: geenbestaande@email.nl

ik wil deze persoon graag helpen door een soort van conversie hulpmiddel aan te bieden. met een druk op de knop tekst omzetten naar Excel.
dan wel in het volgende format:
- 1e kolom: naam
- 2e kolom: telefoon
- 3e kolom: email

heeft iemand een scriptje/macro liggen om dit te bewerkstelligen?
graag hoor ik van jullie.
als ik onduidelijk ben geweest, reageer gerust.

 

[VenA]

Kan je hier een excelvoorbeeldje van maken. Je kan wel codetages gebruiken maar deze zijn niet bedoelt zoals jij ze gebruikt!

 

[spaarie]

Anton,
Als deze info in een e-mail bericht binnen komt in Outlook of dergelijke moet Excel dan deze berichten herkennen en vervolgens openen om de tekst te kopiëren of zoiets? Ik denk dat het niet echt te realiseren is wat je wilt...
Wat wel kan is een MySQL database achter de website waar je de gegevens in plaatst en via Excel een gegevensverbinding met deze database. Hoef je ook geen conversie meer uit te voeren...

Is een stuk makkelijker dan wat je wilt realiseren...

 

[HSV]

De code niet in Excel plaatsen, maar in Outlook.
In onderstaande link heb je de uitleg.
Ik heb de code aangepast voor de body.

Het opent bij mij Excel 2003 terwijl ik ook versie 2007 bezit (misschien dat iemand daar nog wat voor weet).
Uiteraard heb ik naar 12.0 verwezen.

http://www.techrepublic.com/blog/microsoft-office/quickly-export-outlook-e-mail-items-to-excel/

Sub ExportToExcel()
On Error GoTo ErrHandler
Dim appExcel As Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Dim rng As Excel.Range
Dim strSheet As String
Dim strPath As String
Dim intRowCounter As Integer
Dim intColumnCounter As Integer
Dim msg As Outlook.MailItem
Dim nms As Outlook.NameSpace
Dim fld As Outlook.MAPIFolder
Dim itm As Object
Dim i As Long
Dim sq
    strSheet = "OutlookItems.xlsx"          [COLOR=#ff0000]    'bestand even aanmaken[/COLOR]
    strPath = "C:\users\hsv\desktop\"          [COLOR=#ff0000]'bestandenpad aanpassen[/COLOR]
    strSheet = strPath & strSheet 
  'Select export folder
Set nms = Application.GetNamespace("MAPI")
Set fld = nms.PickFolder
  'Handle potential errors with Select Folder dialog box.
If fld Is Nothing Then
      MsgBox "There are no mail messages to export", vbOKOnly, "Error"
    Exit Sub
    ElseIf fld.DefaultItemType <> olMailItem Then
      MsgBox "There are no mail messages to export", vbOKOnly, "Error"
    Exit Sub
    ElseIf fld.Items.Count = 0 Then
      MsgBox "There are no mail messages to export", vbOKOnly, "Error"
    Exit Sub
End If
  'Open and activate Excel workbook.
Set appExcel = CreateObject("Excel.Application")
  appExcel.Workbooks.Open (strSheet)
Set wkb = appExcel.ActiveWorkbook
Set wks = wkb.Sheets(1)
  wks.Activate
appExcel.Application.Visible = True
  'Copy field items in mail folder.
For Each itm In fld.Items
  intColumnCounter = 1
Set msg = itm
  intRowCounter = intRowCounter + 1
Set rng = wks.Cells(intRowCounter, intColumnCounter)
  rng.Value = msg.To
  intColumnCounter = intColumnCounter + 1
Set rng = wks.Cells(intRowCounter, intColumnCounter)
  rng.Value = msg.SenderEmailAddress
  intColumnCounter = intColumnCounter + 1
Set rng = wks.Cells(intRowCounter, intColumnCounter)
  rng.Value = msg.Subject
  intColumnCounter = intColumnCounter + 1
Set rng = wks.Cells(intRowCounter, intColumnCounter)
  rng.Value = msg.SentOn
  intColumnCounter = intColumnCounter + 1
Set rng = wks.Cells(intRowCounter, intColumnCounter)
  rng.Value = msg.ReceivedTime
sq = Split(msg.Body)
For i = 0 To 2
  Set rng = wks.Cells(intRowCounter, intColumnCounter)
  intColumnCounter = intColumnCounter + 1
 rng.Value = sq(i)
Next i
 Next itm
    Set appExcel = Nothing
    Set wkb = Nothing
    Set wks = Nothing
    Set rng = Nothing
    Set msg = Nothing
    Set nms = Nothing
    Set fld = Nothing
    Set itm = Nothing
  Exit Sub
ErrHandler:  If Err.Number = 1004 Then
   MsgBox strSheet & " doesn't exist", vbOKOnly, "Error"
Else
   MsgBox Err.Number & "; Description: ", vbOKOnly, "Error"
End If
    Set appExcel = Nothing
    Set wkb = Nothing
    Set wks = Nothing
    Set rng = Nothing
    Set msg = Nothing
    Set nms = Nothing
    Set fld = Nothing
    Set itm = Nothing
End Sub

 

[antonvdijk]

Bedankt voor de mooie oplossing!
Misschien dat 2003 als standaard toepassing staat geselecteerd en niet 2007?
Misschien dat de versie Outlook uitmaakt?

@Spaarie:
normaliter los ik zoiets inderdaad op met een database erachter.
echter nu niet beschikbaar, dus vandaar de vraag
roeien met de riemen die je hebt, gelukkig dat hier op helpmij een oplossing is