Office: Text formatieren bei Serienmail mit Anhang

Hi!

Ich habe mich gestern im Internet eingelesen und es auch hinbekommen, dass ich eine Serienmail über Word erstellen und mit einem Makro eine .pdf mit jeder Mail rausschicken kann.

Leider stellte sich dabei ein Problem heraus, dass ich nicht selber lösen konnte und auch noch nichts gefunden habe, dass mir dabei helfen könnte. Jetzt brauche ich euch :-D : Die Textformatierungen (fett geschriebenes, Aufzählungspunkte...) sowie ein .jpg mit einem Firmenlogo sind in der endgültigen Email verschwunden. So kann ich die Mails leider nicht rausschicken, würde es aber natürlich gerne über diesen Weg machen, da man so viel Zeit sparen kann.

Hat einer von euch eine Lösung dafür?

Vielen Dank schonmal!!

bbent

 

Fehler im Makro?

Ich habe den Gedanken gehabt, ob es vielleicht am Makro liegen kann, dass die rausgehende Mail nicht richtig formatiert ist und deshalb nicht richtig dargestellt wird?

Hier ist der Code des Makros:





Sub emailmergewithattachments()



Dim Source As Document, Maillist As Document

Dim Datarange As Range

Dim Counter As Integer, i As Integer

Dim bStarted As Boolean

Dim oOutlookApp As Outlook.Application

Dim oItem As Outlook.MailItem

Dim mysubject As String, message As String, title As String



Set Source = ActiveDocument



' Check if Outlook is running. If it is not, start Outlook

On Error Resume Next

Set oOutlookApp = GetObject(, "Outlook.Application")

If Err <> 0 Then

Set oOutlookApp = CreateObject("Outlook.Application")

bStarted = True

End If



' Open the catalog mailmerge document

With Dialogs(wdDialogFileOpen)

.Show

End With

Set Maillist = ActiveDocument



' Show an input box asking the user for the subject to be inserted into the email messages



message = "Enter the subject to be used for each email message." ' Set prompt.

title = " Email Subject Input" ' Set title.

' Display message, title

mysubject = InputBox(message, title)



' Iterate through the rows of the catalog mailmerge document, extracting the information

' to be included in each email.

Counter = 1

While Counter <= Maillist.Tables(1).Rows.Count

Source.Sections.First.Range.Cut

Documents.Add

Selection.Paste

Set oItem = oOutlookApp.CreateItem(olMailItem)

With oItem

.Subject = mysubject

.Body = ActiveDocument.Content

Set Datarange = Maillist.Tables(1).Cell(Counter, 1).Range

Datarange.End = Datarange.End - 1

.To = Datarange

For i = 2 To Maillist.Tables(1).Columns.Count

Set Datarange = Maillist.Tables(1).Cell(Counter, i).Range

Datarange.End = Datarange.End - 1

.Attachments.Add Trim(Datarange.Text), olByValue, 1

Next i

.Send

End With

Set oItem = Nothing

ActiveDocument.Close wdDoNotSaveChanges

Counter = Counter + 1

Wend



' Close Outlook if it was started by this macro.

If bStarted Then

oOutlookApp.Quit

End If



'Clean up

Set oOutlookApp = Nothing

Source.Close wdDoNotSaveChanges

Maillist.Close wdDoNotSaveChanges



End Sub




Ich hoffe, einer von euch kann etwas damit anfangen.... ich nämlich nicht :lol:

Vielen Dank!