Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1936to1940
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
VBA daten von Excel nach Outlook + Signatur
28.07.2023 20:34:25
Bersi
Public Sub SendToMail()
Dim objOutlook As Object
Dim objMail As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = "max@mustermann.de"
.Subject = "Aktuelle Spielliste " & CStr(Date)
.HTMLBody = RangeToHTML(Worksheets("Mail"), Worksheets("Mail").Range("A1:H74")) & .HTMLBody
.Display
'.Send
End With
Set objMail = Nothing
Set objOutlook = Nothing
End Sub

Private Function RangeToHTML(objSheet As Worksheet, objRange As Range) As String
Dim strFilename As String
strFilename = Environ$("TEMP") & "/" & Format(Now, "dd-mm-yyyy_hh-mm-ss") & ".htm"
ActiveWorkbook.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=strFilename, _
Sheet:=objSheet.Name, _
Source:=objRange.Address, _
HtmlType:=xlHtmlStatic).Publish True
RangeToHTML = CreateObject("Scripting.FileSystemObject"). _
GetFile(strFilename).OpenAsTextStream(1, -2).ReadAll
Kill strFilename
End Function







Die Zeilen kopiert er aber die Signatur wird nicht angezeigt was mache ich hier Falsch ich finde den Fehler nicht. Ich hoffe mir kann einer weiterhelfen.

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA daten von Excel nach Outlook + Signatur
28.07.2023 21:29:05
volti
Hallo Bersi,

Du musst die Signatur erst über .GetInspector holen bevor Du sie verwenden kannst.
Public Sub SendToMail()
Dim objOutlook As Object
Dim objMail As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.GetInspector.Display
.To = "max@mustermann.de"
.Subject = "Aktuelle Spielliste " & CStr(Date)
.HTMLBody = RangeToHTML(Worksheets("Mail"), Worksheets("Mail").Range("A1:H74")) & .HTMLBody
'.Send
End With
Set objMail = Nothing
Set objOutlook = Nothing
End Sub


Gruß Karl-Heinz
Anzeige
AW: VBA daten von Excel nach Outlook + Signatur
28.07.2023 22:32:56
Bersi
Vielen Vielen Dank es klappt :-)
AW: VBA daten von Excel nach Outlook + Signatur
30.07.2023 10:32:46
Ulf
Hi,
für alle, die wie meinereiner mehrere Konten in einer pst verwenden hier der angepasste Code zum Signieren:


Option Explicit

Public Sub SendToMail()
Dim objOutlook As Outlook.Application
Dim objMail As Outlook.MailItem
Dim strBody As String
Dim strSign As String
Dim strFiles As Variant
Set objOutlook = New Outlook.Application
Set objMail = objOutlook.CreateItem(olMailItem)
'!!! Ranges anpassen !!!
strBody = RangeToHTML(Worksheets(1), Worksheets(1).Range("A1:F74"))
With objMail
.BodyFormat = olFormatHTML
strSign = holeSignatur(objMail)
.To = "max@mustermann.de"
.Subject = "Aktuelle Spielliste " & CStr(Date)
.HTMLBody = .HTMLBody & strBody & "

" & strSign
.Display
'.Send
End With
Set objMail = Nothing
Set objOutlook = Nothing
End Sub

Public Function RangeToHTML(objSheet As Worksheet, objRange As Range) As String
On Local Error GoTo RangeToHTMLERR
Dim strFilename As String
strFilename = Environ$("TEMP") & "/" & Format(Now, "dd-mm-yyyy_hh-mm-ss") & ".htm"
ActiveWorkbook.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=strFilename, _
Sheet:=objSheet.Name, _
Source:=objRange.Address, _
HtmlType:=xlHtmlStatic).Publish True
RangeToHTML = CreateObject("Scripting.FileSystemObject"). _
GetFile(strFilename).OpenAsTextStream(1, -2).ReadAll
Kill strFilename
RangeToHTMLOUT:
Exit Function
RangeToHTMLERR:
'msgbox err ...
Resume RangeToHTMLOUT
End Function

Public Function holeSignatur(ByRef objMail As Outlook.MailItem, Optional ByVal strName As String = "DEFAULT_HIER_EINTRAGEN") As String
On Local Error GoTo holeSignaturERR
Dim strPfad As String
Dim strDatei As String
Dim strFound As String
Dim strRet As String
Dim strTemp As String
Dim strErsatz As String
'Signaturen sollten in zu finden sein
'C:\Users\USERNAME\AppData\Roaming\Microsoft\Signatures
strPfad = Environ("USERPROFILE") & "\AppData\Roaming\Microsoft\Signatures"
strDatei = strName & ".htm"
strFound = Dir$(strPfad & "\" & strDatei, vbNormal)
If strFound = strDatei Then
strRet = CreateObject("Scripting.FileSystemObject"). _
GetFile(strPfad & "\" & strDatei).OpenAsTextStream(1, -2).ReadAll
End If
'!!! Diese image.001.jpg im entsprechenden Ordner einmalig suchen/anpassen !!!
'ggf. muß/kann man mit dir$().. im Text der htm-Datei suchen und hier einsetzen
strErsatz = Replace(strPfad, "\", "/") & "/" & strName & "-Dateien/image001.jpg"
strTemp = Replace(strRet, strName & "-Dateien/image001.jpg", strErsatz)
strRet = strTemp
holeSignaturOUT:
holeSignatur = strRet
Exit Function
holeSignaturERR:
strRet = ""
Resume holeSignaturOUT
End Function
Anzeige

85 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige