vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Blitzschnelles Erstellen von grafischen Diagrammen!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück

 Sie sind aktuell nicht angemeldet.Funktionen: Einloggen  |  Neu registrieren  |  Suchen

Allgemeine Diskussionen
Mail von Outlook nach Excel Daten auslesen 
Autor: Tobi612
Datum: 27.01.17 10:55

Hallo zusammen,

ich habe diese Frage schon einmal in einem anderen Forum gestellt und auch eine Antwort erhalten, leider funktioniert der vba code noch nicht ganz.

Hier noch einmal mein Problem:
Und zwar bekomme ich regelmäßig eine Mail mit Daten, diese Daten möchte ich gerne via Makro nach Excel exportieren.

Das klappt bisher soweit auch ganz gut, das einzige Problem ist, das der gesamte Mail Inhalt in Zelle A1 eingefügt wird.

Mein Wunsch wäre es das die Daten in die Zellen A1 - A32 eingefügt werden.

Die Mail gliedert sich so

"Informationen zu ...."

01.01.2017 Aktueller Dienst: XX
02.01.2017 Aktueller Dienst: YY

Jedes Datum soll, mit dem text "Aktueller Dienst: XX also in eine Zelle.

Hier der FAST funktionierende Code:
Sub OutlookPosteingang()
'Variablendeklaration
Dim OLF As Outlook.MAPIFolder
Dim AnzEintraege As Integer, i As Integer, Email As Integer
Dim varBody, intBody As Integer
' Hier wird eine Tabelle hinzugefügt
ActiveSheet.Name = i
'Globale Fehlerbehandlung -> Excel soll automatisch weitermachen, egal welcher Fehler
On Error Resume Next
' Überschriften im neuen Blatt -> die erste Zeile von A1 - B1
[A1].Value = ""
'Erste Zeile soll Fett formatiert werden
Rows(1).Font.Bold = True
'Setzen der Variable als Outlook Application; Zugriff auf Outlook
Set OLF = GetObject("", "Outlook.Application") _
.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
'Setzen der Variable -> es sollen alle Nachrichten im Ordner 'Posteingang (olFolderInbox) _
gezählt werden
AnzEintraege = OLF.Items.Count
'Setzen der Variablen auf '0'
i = 0: Email = 0
'Beginn Schleifendurchlauf (Schleife 1) -> die Variable 'i' läuft solange, wie Anzahl _
der EMails vorhanden sind
While i < AnzEintraege
i = i + 1
'Anzeigen einer Nachricht in der Statuszeile
Application.StatusBar = "Lese Posteingang " & _
Format(i / AnzEintraege, "0%")
'Was soll mit den Nachrichten geschehen? (Schleife 2)
With OLF.Items(i)
'Zelle 5 mit der eigentlichen Nachricht
'Body-Text an der Zeilenschaltung splitten
varBody = Split(.Body, Chr$(13)) 'evtl. auch Chr$(10) als Trennzeichen verwenden
'Zeilen des Body-Textes eintragen in Tabellenblatt
For intBody = LBound(varBody) To UBound(varBody)
'Zeilenzähler erhöhen
Email = Email + 1
'Prüfen, ob am Anfang der Zeile ein Datum steht
If IsDate(Left(varBody(intBody), 10)) Then
Cells(Email, 1).Value = CDate(Left(varBody(intBody), 10))
varBody(intBody) = Trim(Mid(varBody(intBody), 11))
If InStr(varBody(intBody), ":") > 0 Then
Cells(Email, 2).Value = Left(varBody, InStr(varBody(intBody), ":"))
Cells(Email, 3).Value = Trim(Mid(varBody, InStr(varBody(intBody), ":") + 1))
Else
Cells(Email, 2).Value = varBody(intBody)
End If
Else
Cells(Email, 1).Value = varBody(intBody)
End If
Next
'Ende der Schleife 2
End With
'Ende der Schleife 1
Wend
'Die Variable muss wieder auf Null gesetzt werden = nothing halt
Set OLF = Nothing
'Die Spalten sollen automatisch in der Breite angeglichen werden
Columns("A:F").AutoFit
'Die Zelle 'A2' soll selektiert werden
[A2].Select
'Die Exceldatei wird gespeichert
ActiveWorkbook.Saved = True
'Die Statuszeile wird wieder ausgeschaltet
Application.StatusBar = False
End Sub


Und nun das neue Problem:

Durch den Code werden die Daten sehr schön in die gewünschten Zellen geschrieben. Leider jedoch verschwindet jedoch auch der benötigte Text "aktueller Dienst"nach dem Datum. Anstelle von XX bzw YY wird ein Zahlen Buchstaben kürzel verwendet zb. R1

Was muss ich wo einfügen?

Vielen Dank für eure Hilfe.

Grüße Tobi

Themenbaum einblendenGesamtübersicht  |  Zum Thema  |  Suchen

Re: Mail von Outlook nach Excel Daten auslesen 
Autor: effeff
Datum: 30.01.17 22:50

Wenn ich das richtig verstehe, brauchst Du doch nach Datum gar nicht zu prüfen. Es reicht doch, wenn Du in der Zeile feststellst, dass dort ein Doppelpunkt ist. Wenn "Aktueller Wert" unbedingt mit im Text stehen soll, reicht es doch, in Spalte A die ersten zehn Zeichen für das Datum und in Spalte B alles ab Zeichen 12 einzutragen:

Sub juhu()
 
Dim strText As String
 
strText = "Informationen zu ...." & vbCrLf & "01.01.2017 Aktueller Dienst: XX" _
  & vbCrLf & "02.01.2017 Aktueller Dienst: YY"
 
Dim strZeilen() As String 'Array, um Zeilen aufzusplitten
 
strZeilen = Split(strText, vbCrLf)
 
Dim i As Integer
 
For i = 0 To UBound(strZeilen)
 
If InStr(1, strZeilen(i), ":") Then
Sheets("Tabelle1").Cells(i + 1, 1).Value = Left(strZeilen(i), 10)
Sheets("Tabelle1").Cells(i + 1, 2).Value = Mid(strZeilen(i), 12, Len(strZeilen( _
  i)) - 11)
Else
Sheets("Tabelle1").Cells(i + 1, 1).Value = strZeilen(i)
End If
 
Next
 
End Sub
Zudem habe ich das Gefühl, dass Du für jede Mail ein neues Arbeitsblatt haben möchtest, was Dein Code aber gar nicht hergibt, da dort nur einmal ein Tabellenblatt umbenennst (das aktive), aber kein neues hinzufügst. Die Anweisung zum Speichern einer Arbeitsmappe heißt dann "ActiveWorkbook.Save = True" und nicht "ActiveWorkbook.Saved = True". Du verwendest Variablen, ohne sie deklariert zu haben....

EALA FREYA FRESENA

Themenbaum einblendenGesamtübersicht  |  Zum Thema  |  Suchen

Sie sind nicht angemeldet!
Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden.

Einloggen  |  Neu registrieren

Funktionen:  Zum Thema  |  GesamtübersichtSuchen 

nach obenzurück
 
   

Copyright ©2000-2024 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel