Hallo!
Das Thema hatte ich doch erst vor Kurzem in einem anderen Forum. ;)
Denn Code musst Du noch anpassen. Der Body wird per Array ausgelesen. Ein Array beginnt immer bei 0. Einen Verweis auf dei Excel Object Library setzen.
Option Explicit
Public Sub AnmeldedatenEintragen()
Dim xlApp As Object
Dim xlRange As Long
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim vntTempArray As Variant
Dim obj As Object
Select Case True
Case TypeOf Application.ActiveWindow Is Outlook.Inspector
Set obj = Application.ActiveInspector.CurrentItem
Case Else
With Application.ActiveExplorer.Selection
If .Count Then Set obj = .Item(1)
End With
If obj Is Nothing Then Exit Sub
End Select
vntTempArray = Split(obj.Body, vbCrLf)
Set xlApp = New Excel.Application
With xlApp
.Visible = True
.Workbooks.Open Environ("USERPROFILE") & "\Documents\Ziel\Tester.xlsx"
Set xlBook = xlApp.Workbooks("Tester.xlsx")
Set xlSheet = xlBook.Sheets("Tabelle1")
With xlBook
With xlSheet
xlRange = _
.Range("A" & .Rows.Count).End(xlUp).Row + 1
.Range("A" & xlRange) = Replace(vntTempArray(3), "Anrede: ", "")
.Range("B" & xlRange) = Replace(vntTempArray(4), "Titel: ", "")
.Range("C" & xlRange) = Replace(vntTempArray(5), "Vorname: ", "")
.Range("D" & xlRange) = Replace(vntTempArray(6), "Nachname: ", "")
.Range("E" & xlRange) = Replace(vntTempArray(7), "Praxis: ", "")
.Range("F" & xlRange) = Replace(vntTempArray(8), "Strasse: ", "")
.Range("G" & xlRange) = Replace(vntTempArray(9), "PLZ/Ort: ", "")
.Range("H" & xlRange) = Replace(vntTempArray(10), "Telefon: ", "")
.Range("I" & xlRange) = Replace(vntTempArray(11), "E-Mail: ", "")
.Range("I" & xlRange) = Replace(vntTempArray(12), "Teilnehmer: ", "")
End With
.Save
.Close
End With
.Quit
End With
ende:
xlRange = 0
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
End Sub
VBA/HTML - CodeConverter für Office-Foren, AddIn für Office 2002-2013 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:mumpel
Code erstellt und getestet in Office 15 - mit VBAHTML 12.6.0
Gruß, René
