VB Script - Textabschnitte aus Outlook Email kopieren und speichern als doc oder pdf
erstellung eines Scripts für outlook
Hallo, ich habe folgende Aufgabenstellung bekommen.
Es soll ein Script angefertigt werden welches ermöglicht, das in einer bekommenen Email, automatisch nach Textabschnitten zu suchen. Diese sollen dann entsprechend kopiert werden und in *.doc oder *.pdf.
Bsp für die Suche:
Von dem Wort Kaufbestätigung bis zum Zeilenende des nächsten Wortes welches gesucht wurde.
von Wort A: Kaufbestätigung bis zum ende der Zeile von Wort B: Herkunft
dawzsichen ist dann wieder ganz viel uninteressanter Text.
danach soll wieder von
Wort C: Käufer bis zum ende der Teile von Wort D: Geldinstitut.
Dies soll dann alles markiert und ein eine DOC oder PDF Datei eingefügt werden, sodass diese dann manuell gespeichert werden muss.
Ich hoffe Ihr könnt mir da ein paar Tipps geben.
Vielen Dank
Es soll ein Script angefertigt werden welches ermöglicht, das in einer bekommenen Email, automatisch nach Textabschnitten zu suchen. Diese sollen dann entsprechend kopiert werden und in *.doc oder *.pdf.
Bsp für die Suche:
Von dem Wort Kaufbestätigung bis zum Zeilenende des nächsten Wortes welches gesucht wurde.
von Wort A: Kaufbestätigung bis zum ende der Zeile von Wort B: Herkunft
dawzsichen ist dann wieder ganz viel uninteressanter Text.
danach soll wieder von
Wort C: Käufer bis zum ende der Teile von Wort D: Geldinstitut.
Dies soll dann alles markiert und ein eine DOC oder PDF Datei eingefügt werden, sodass diese dann manuell gespeichert werden muss.
Ich hoffe Ihr könnt mir da ein paar Tipps geben.
Vielen Dank
Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-Key: 79434
Url: https://administrator.de/contentid/79434
Ausgedruckt am: 28.03.2024 um 11:03 Uhr
11 Kommentare
Neuester Kommentar
Hier mal der Code zum Auslesen bestimmter Teile im Inhaltstext einer Email.
miniversum
Sub Textausschnitte()
WortA = "Wort A"
WortB = "Wort B"
WortC = "Wort C"
WortD = "Wort D"
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myfolder = myNameSpace.GetDefaultFolder(olFolderInbox)
Text = myfolder.Items(1).Body
posA = InStr(1, Text, WortA)
posB = InStr(posA, Text, WortB)
ABText = Mid(Text, posA, posB - posA)
posC = InStr(posB, Text, WortC)
posD = InStr(posC, Text, WortD)
ABText = Mid(Text, posA, posB - posA)
CDText = Mid(Text, posC, posD - posC)
MsgBox "ABText: " & ABText
MsgBox "CDText: " & CDText
End Sub
miniversum
Hier der Code nochmal mit Komantaren zur Erklärung
miniversum
Sub Textausschnitte()
' Suchbegriffe festlegen
WortA = "Wort A"
WortB = "Wort B"
WortC = "Wort C"
WortD = "Wort D"
' Zugriff auf Posteingang herstellen (myfolder -> Posteingang)
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myfolder = myNameSpace.GetDefaultFolder(olFolderInbox)
' Hole den Bodytext der ersten/obersten Email im Posteingang und schreibe ihn in die Variable Text
Text = myfolder.Items(1).Body
posA = InStr(1, Text, WortA) ' Suche die Position von WortA im Text und schreibe diese in posA
posB = InStr(posA, Text, WortB) ' Suche die Position von WortB nach WortA im Text und schreibe diese in posB
ABText = Mid(Text, posA, posB - posA) ' Hole den Textteil zwischen posA und posB in Text und schreibe ihn in die Variable ABText
posC = InStr(posB, Text, WortC) ' Suche die Position von WortC nach WortB im Text und schreibe diese in posC
posD = InStr(posC, Text, WortD) ' Suche die Position von WortD nach WortC im Text und schreibe diese in posD
CDText = Mid(Text, posC, posD - posC) ' Hole den Textteil zwischen posC und posD in Text und schreibe ihn in die Variable CDText
MsgBox "ABText: " & ABText ' Zeige ABText an
MsgBox "CDText: " & CDText ' Zeige CDText an
End Sub
Es geht direkt, also ohne Zwischenablage.
Wie sieht den dein Code aus um Word zu öffnen?
Ich würde es in der Art machen:
miniversum
Wie sieht den dein Code aus um Word zu öffnen?
Ich würde es in der Art machen:
Set objWordApp = CreateObject("Word.application") ' Starten von Word
'Starten der Word-Instanz und eine neues Dokument öffnen
objWordApp.Visible = True ' Word sichtbar machen
Set objWordDok = objWordApp.documents.Add ' En neues Dokument in Word erstellen
' Text in Word schreiben
objWordApp.TypeText Text:="Daten aus Outlook"
objWordApp.TypeParagraph ' Neue Zeile
objWordApp.TypeText Text:="ABText: " & ABText ' Schreibe ABText in das Word Dokument
objWordApp.TypeParagraph ' Neue Zeile
objWordApp.TypeText Text:="CDText: " & CDText ' Schreibe CDText in das Word Dokument
objWordApp.TypeParagraph ' Neue Zeile
miniversum
Jetzt nochmal alles in einem. Da ist woll was unübersichtlich geworden. und ein selection hat gefehlt...:
So hab ichs grade bei mir getestet udn es funktioniert
miniversum
Sub Textausschnitte()
' Suchbegriffe festlegen
WortA = "Kaufbestätigung"
WortB = "Modellgruppe:"
WortC = "Käufer:"
WortD = "Sie"
' Zugriff auf Posteingang herstellen (myfolder -> Posteingang)
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set myfolder = myNameSpace.GetDefaultFolder(olFolderInbox)
' Hole den Bodytext der ersten/obersten Email im Posteingang und schreibe ihn in die Variable Text
Text = myfolder.Items(1).Body
posA = InStr(1, Text, WortA) ' Suche die Position von WortA im Text und schreibe diese in posA
posB = InStr(posA, Text, WortB) ' Suche die Position von WortB nach WortA im Text und schreibe diese in posB
ABText = Mid(Text, posA, posB - posA) ' Hole den Textteil zwischen posA und posB in Text und schreibe ihn in die Variable ABText
posC = InStr(posB, Text, WortC) ' Suche die Position von WortC nach WortB im Text und schreibe diese in posC
posD = InStr(posC, Text, WortD) ' Suche die Position von WortD nach WortC im Text und schreibe diese in posD
CDText = Mid(Text, posC, posD - posC) ' Hole den Textteil zwischen posC und posD in Text und schreibe ihn in die Variable CDText
Set objWordApp = CreateObject("Word.application") ' Starten von Word
'Starten der Word-Instanz und eine neues Dokument öffnen
objWordApp.Visible = True ' Word sichtbar machen
Set objWordDok = objWordApp.documents.Add ' Ein neues Dokument in Word erstellen
' Text in Word schreiben
objWordApp.Selection.TypeText Text:="Daten aus Outlook"
objWordApp.Selection.TypeParagraph ' Neue Zeile
objWordApp.Selection.TypeText Text:="ABText: " & ABText ' Schreibe ABText in das Word Dokument
objWordApp.Selection.TypeParagraph ' Neue Zeile
objWordApp.Selection.TypeText Text:="CDText: " & CDText ' Schreibe CDText in das Word Dokument
objWordApp.Selection.TypeParagraph ' Neue Zeile
' Zuordnungen löschen
Set myOlApp = Nothing
Set objWordApp = Nothing
End Sub
miniversum
halli hallo...,
ich hab da mal eine frage ...
Wie kann man dieses Script so umschreiben, dass er beim senden von E-Mails im header nach "Disposition-Notification-To" suchen soll und wenn er es dann gefunden hat soll er den Item.Subject in einer Text datei rein schreiben.
Hat evtl. jemand eine Idee dazu???
Danke schön schon mal im voraus
ich hab da mal eine frage ...
Wie kann man dieses Script so umschreiben, dass er beim senden von E-Mails im header nach "Disposition-Notification-To" suchen soll und wenn er es dann gefunden hat soll er den Item.Subject in einer Text datei rein schreiben.
Hat evtl. jemand eine Idee dazu???
Danke schön schon mal im voraus