Hallo Zusammen
Mein Problem ist folgendes. ich möchte aus einer Excel-datei heraus eine Tabelle inkl. einem kurzen Text in eine Mail kopieren. Dabei soll auch die Formatierung entsprechend übernommen werden. Ich habe dafür nach ein bisschen rumbasteln eine valable Lösung gebaut. Leider hab ich aber unbeabsichtigt etwas im Code geändert, weswegen jetzt zwar ein Mail erstellt wird, jedoch der vorgesehene (und korrekte) Inhalt nur in ein neues Excel-book kopiert wird. Der body der Mail bleibt leer. Kann mir jemand sagen, wo der Wurm in meinem Code steckt?
Beste Grüsse, Alex
-----------------------------------------
Sub email()
Dim OutApp As Object
Dim OutMail As Object
Dim Fname As String
Dim hoja As String
Dim rng As Range
Dim celdas As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Set rng = Sheets("Maske").Range("A2:P39")
On Error Resume Next
With OutMail
For x = 4 To 14
Let E_Mail_Address_to = Worksheets("Email").Cells(x, 1).Value
If E_Mail_Address_to <> "" Then
E_Mail_List_TO = E_Mail_List_TO & ";" & E_Mail_Address_to
End If
Next
.To = E_Mail_List_TO
For x = 4 To 14
Let E_Mail_Address_cc = Worksheets("Email").Cells(x, 4).Value
If E_Mail_Address_cc <> "" Then
E_Mail_List_CC = E_Mail_List_CC & ";" & E_Mail_Address_cc
End If
Next
.CC = E_Mail_List_CC
'Subject
'perDate = Format(Now, "dd.mm.YYYY")
Let SubjectLine = "FX Umschichtung"
.Subject = SubjectLine
.HTMLBody = RangetoHTML(rng)
.Display 'or use .Display
End With
On Error GoTo 0
'Kill Fname
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
-------------------------------------------------------
Function RangetoHTML(rng As Range)
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
Dim lngLetzte As Long
Dim intLetzte As Integer
Set TempWB = Workbooks.Add(1)
ThisWorkbook.Worksheets(2).Copy Before:=TempWB.Worksheets(1)
With TempWB.Worksheets(1)
lngLetzte = .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious). _
_
_
_
Row
intLetzte = .Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:= _
xlPrevious).Column
.Range(Cells(39, 1), Cells(lngLetzte, intLetzte)).ClearContents
End With
'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
'Close TempWB
TempWB.Close savechanges:=False
'Delete the htm file we used in this function
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
|