sendmail läuft (nicht) mehr
11.01.2013 23:34:42
Annett
seit einiger Zeit benutze ich folgendes Makro zu versenden eines bestimmten Tabellenbereiches aus Excel. Ich habe diesen Code aus dem Netz übernommen und etwas angepasst. Dieses funktionierte bisher auch gut. Ich benutze Excel 2003 und Outlook 2003.
Die Exceldatei wird hier bei uns auf mehreren Rechnern angewendet. Jezt wurden die Rechner auf die Outlookversion 2010 umgestellt. Excel ist bei 2003 geblieben.
Das Problem ist, dass das Makro nur noch funktioniert, wenn Outlook vorher geöffnet wurde. Das ist aber nicht immer gewährleistet. Starte ich das Makro als Einzelschritt mit F8, kommt am Punkt ".send" die Fehlermeldung "Laufzeitfehler 287 Anwendung oder objektdefinierter Fehler".
Ich habe bereits längere Zeit nach diesem Problem im Netz gesucht und auch einiges gefunden. Allerdings habe ich recht geringe VBA Kentnisse und kann mit vielen Antworten nichts anfangen.
Kann mir denn hier jemand helfen, den Code so abzuändern, dass dieser wieder läuft?
Danke Annett
Hier noch das aktuelle Makro:
Sub Senden()
Dim objOutlook As Object
Dim objMail As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.to = "aa@bb.de"
.Subject = "testmail"
.HTMLBody = RangeToHTML(ActiveSheet, ActiveSheet.Range("a1:a5"))
.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