106543
106543
May 03, 2013
view16757
view10
0
Goto Top

VBA - Tabellenformatierung in Mail beibehalten

GermansolvedQuestionVB for ApplicationsDevelopment
Hi Leute face-smile

immer noch bin ich am selben Tool dran und immer noch bereitet mir die tabelle Kopfzerbrechen

habe folgenden Code:
Sub Mail_senden()

sNachricht = UserForm1.TextBox_Mailtext.Text

If sBetreff = "" Or sNachricht = "" Or sEmpfänger = "" Then  
    MsgBox "Es muss ein Betreff, ein Text und ein Empfänger für die Nachricht gegeben sein." & vbCrLf & "Bitte die Ressourcen-Listen überprüfen.", , "Error"  
    Call Log_Meldung("Entweder Betreff, Nachricht oder Empfänger leer. Abbruch des Mailversands.")  
    Exit Sub
End If

If UserForm1.Option_Retoure = True Then
    Dim iZelle2 As String
    For i = 2 To 40
        If Worksheets(2).Cells(i, 1) = "" Then  
            i = i - 1
            Exit For
        End If
    Next
    sZelle2 = "D" & i  
    ThisWorkbook.Sheets("Tabelle2").Select  
    Range("A1", sZelle2).Select  
    Application.Selection.Copy
    
    Dim oClipboard As Object
    Dim sClipBoardString As String
    Set oClipboard = New DataObject
    oClipboard.GetFromClipboard
    sClipBoardString = oClipboard.GetText
    sNachricht = Replace(sNachricht, "Bitte hier die Tabelle einfügen... (STRG +V)", sClipBoardString)  
End If

Dim sAbsender As String
Dim Outlook As Object
Dim Nachricht As Object

Set Outlook = CreateObject("Outlook.Application")  
Set Nachricht = Outlook.CreateItem(0)
sAbsender = "Ftth-Aussendienst@telekom.de"  

'Nachricht.To sEmpfänger  
Nachricht.Recipients.Add sEmpfänger
Nachricht.SentOnBehalfOfName = sAbsender
Nachricht.CC = "Ralf.Jochim@telekom.de;AEngel.telekom.de"  
Nachricht.Subject = sBetreff
Nachricht.Body = sNachricht
Nachricht.ReadReceiptRequested = False
Nachricht.Display
Call Log_Meldung("Mail wurde erstellt mit dem Empfänger: " & sEmpfänger & " und dem Absender: " & sAbsender & " und dem Betreff: " & sBetreff & " und dem Nachrichtentext: " & sNachricht)  

Set Outlook = Nothing
    
End Sub

nun fügt er mir zwar brav die Tabelle in Outlook ein, aber die Formatierung ist total zerschossen und die Tabellen-"Trenn"-Linien werden nicht mehr angezeigt face-confused

Weiß einer von euch ´ne Möglichkeit, das Ding wieder zu formatieren ?

Grüße
Exze
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 205981

Url: https://administrator.de/contentid/205981

Printed on: April 27, 2024 at 03:04 o'clock

10 Comments
Latest comment
Goto Top
Member: colinardo
colinardo May 03, 2013 updated at 08:56:31 (UTC)
Goto Top
Deine Mail hat wahrscheinlich Nur-Text-Format:
ändere mal
Nachricht.Body = sNachricht
in
Nachricht.HTMLBody = sNachricht

eventuell ist auch in den Zwischenablage-Einstellungen von Outlook festgelegt das standardmässig nur der Text übernommen wird und nicht die Formatierung.

Grüße Uwe
Mitglied: 106543
106543 May 03, 2013 at 08:55:27 (UTC)
Goto Top
Hi Uwe,

ja die hat nur Textformat, wenn ich allerdings HTMLBody verwende zerschießts mir die Formatierung des restlichen Texttes was auch nicht Sinn der Sache ist face-confused

Grüße
Exze
Member: colinardo
colinardo May 03, 2013 at 09:28:56 (UTC)
Goto Top
Habe gerade nachgelesen, das DataObject unterstützt im Moment nur Textformate d.h. Formatierungen lassen sich damit nicht übertragen.
Ich schaue mal nach Alternativen...
Mitglied: 106543
106543 May 03, 2013 at 09:36:19 (UTC)
Goto Top
Dank dir face-smile

von Hand STRG+V funktioniert ja, von daher könnte man´s mit SendKeys machen, will aber nicht mit SendKeys arbeiten -_-
Da kommen immer ganz komische Dinger raus, wenn der User n anderes Fenster in dem Moment selektiert.

Grüße
Exze
Member: colinardo
colinardo May 03, 2013 at 09:36:39 (UTC)
Goto Top
Du könntest den Inhalt des Ranges in HTML wandeln und dann in die Mail einfügen wie hier beschrieben:
http://www.rondebruin.nl/win/s1/outlook/bmail2.htm
Mitglied: 106543
106543 May 03, 2013 at 09:40:57 (UTC)
Goto Top
Hi Uwe,

wie schon gesagt, kann ich den HTMLBody nicht nutzen, weil sonst der restliche Text nicht mehr formatiert ist face-smile
danke für die Mühe aber ich denke ich muss einfach mit SendKeys abreiten.
Jetzt muss ich mur nur eine Möglichkeit finden, den User keine andere Application auswählen zu lassen.
Screenupdating = false klingt gut.

Danke für deine Mühe
Grüße
Exze
Mitglied: 106543
106543 May 03, 2013 at 10:56:42 (UTC)
Goto Top
so ich markier den Beitrag jetzt mal als gelöst face-smile
ich hänge auch mal den VBA-Quellcode an
zwar nicht die von mir erhoffte Lösung, aber es funktioniert
Sub Mail_senden()

sNachricht = UserForm1.TextBox_Mailtext.Text

If sBetreff = "" Or sNachricht = "" Or sEmpfänger = "" Then  
    MsgBox "Es muss ein Betreff, ein Text und ein Empfänger für die Nachricht gegeben sein." & vbCrLf & "Bitte die Ressourcen-Listen überprüfen.", , "Error"  
    Call Log_Meldung("Entweder Betreff, Nachricht oder Empfänger leer. Abbruch des Mailversands.")  
    Exit Sub
End If

If UserForm1.Option_Retoure = True Then
    Dim iZelle2 As String
    For i = 2 To 40
        If Worksheets(2).Cells(i, 1) = "" Then  
            i = i - 1
            Exit For
        End If
    Next
    sZelle2 = "D" & i  
    ThisWorkbook.Sheets("Tabelle2").Select  
    Range("A1", sZelle2).Select  
    Application.Selection.Copy
    sNachricht = Replace(sNachricht, "Bitte hier die Tabelle einfügen... (STRG +V)", "")  
End If

Dim sAbsender As String
Dim Outlook As Object
Dim Nachricht As Object
Dim outlook2 As Object

Set Outlook = CreateObject("Outlook.Application")  
Set Nachricht = Outlook.CreateItem(0)
sAbsender = "Ftth-Aussendienst@telekom.de"  

'Nachricht.To sEmpfänger  
Nachricht.Recipients.Add sEmpfänger
Nachricht.SentOnBehalfOfName = sAbsender
Nachricht.CC = "Ralf.Jochim@telekom.de;AEngel.telekom.de"  
Nachricht.Subject = sBetreff
Nachricht.Body = sNachricht
Nachricht.ReadReceiptRequested = False
Nachricht.Display
Call Log_Meldung("Mail wurde erstellt mit dem Empfänger: " & sEmpfänger & " und dem Absender: " & sAbsender & " und dem Betreff: " & sBetreff & " und dem Nachrichtentext: " & sNachricht)  

Application.Wait (10)

If UserForm1.Option_Retoure = True Then
    If UserForm1.Option_NurMit = True Or UserForm1.Option_GemischtMit = True Then
        Application.SendKeys ("{DOWN}")  
        Application.SendKeys ("{DOWN}")  
        Application.SendKeys ("{DOWN}")  
        Application.SendKeys ("{DOWN}")  
        Application.SendKeys ("{DOWN}")  
        Application.SendKeys ("{DOWN}")  
        Application.SendKeys ("{DOWN}")  
        Application.SendKeys ("{DOWN}")  
        Application.SendKeys ("{DOWN}")  
        Application.SendKeys ("^v")  
    End If
End If

Set Outlook = Nothing

End Sub
Member: colinardo
colinardo May 03, 2013 updated at 11:24:19 (UTC)
Goto Top
Noch zur Info ein Zellenbereich lässt sich auch als Bild kopieren. Dann sieht das beim Empfänger immer gleich aus.

In deinem Script in Zeile 23:
Application.Selection.CopyPicture

--edit--
nach dem aufrufen der .Display-Methode kannst du noch folgendes machen damit das Mailfenster zuverlässiger in den Vordergrund kommt:
Outlook.ActiveInspector.Activate

Application.Wait (10) => geht nicht ... Die Zeit muss im Datumsformat von Excel erfolgen z.B. so
Application.Wait Now + TimeValue("0:00:01")
Mitglied: 76109
76109 May 03, 2013, updated at May 05, 2013 at 12:28:59 (UTC)
Goto Top
Hallo Exzellius!

Hier noch was zum experimentieren...:
    Dim oHtml           As PublishObject
    Dim sSheetName      As String
    Dim sSheetRange     As String
    Dim sHtmFile        As String
    Dim sHtmTitel       As String
    Dim sHtmBody        As String
    Dim sHtmText        As String
    
    sSheetName = "Tabelle1"     'Tabellenname  
    sSheetRange = "A1:F20"      'Tabellen-Bereich  
    
    sHtmTitel = "Mein Titel"    'Überschrift Fett  
    sHtmText = "Mein Text"      'Text  
    
    sHtmFile = Environ("Temp") & "\" & sSheetName & ".htm"  
    
    Set oHtml = ThisWorkbook.PublishObjects.Add( _
                             SourceType:=xlSourceRange, Filename:=sHtmFile, _
                             Sheet:=sSheetName, Source:=sSheetRange, Title:=sHtmTitel)
    
    oHtml.Publish True      'Htm-Datei erzeugen  
    
    sHtmBody = CreateObject("Scripting.FileSystemObject").OpenTextFile(sHtmFile).ReadAll  
    
    sHtmBody = Replace(sHtmBody, "<table", "<p>" & sHtmText & "</p>" & vbCrLf & "<table")  
    
    '.....  
        '.HTMLbody = sHtmBody  
    '.....  
    
    oHtml.Delete:   Kill sHtmFile

Gruß Dieter

[edit]
Der Vollständigkeit halber noch colinardos Anregung mit CopyPicture und GetInspector...:
    Sheets("Tabelle1").Range("A5:F8").CopyPicture xlScreen, xlBitmap  

    With CreateObject("Outlook.Application").CreateItem(0)  
        '......  
        .Body = sMessage
         With .GetInspector.WordEditor.Paragraphs
            .Add
            .Last.Range.Paste
         End With
         Application.CutCopyMode = False
        .Display
    End With
[/edit]
Mitglied: 106543
106543 May 10, 2013 at 06:56:34 (UTC)
Goto Top
Hi ihr beiden,

danke für die Anregungen face-smile
@colinardo: als Bild kopieren wäre nicht geeignet, weil die User selbst Daten eintragern müssen und zwar noch in der Mail, das wäre mit einem Bild nicht möglich.
@did1954: danke, werd mal schauen was ich da verwenden kann.

Grüße
Exze
GermansolvedQuestionVB for ApplicationsDevelopment