Excel 03: Mail mittels Vbscript mit Signatur versenden

Hallo Leute,... hab nProblem,...

Möchte aus einer Excel-Datei ein Arbeitsblatt versende,... das funktioniert auch,...
im Betreff passt auch alles,...

Problem: Es ist ein Firmenmail, und da sollte dann im Mail unsere bzw. meine Signatur stehen, dass der Empfänger weiß, von wem, Firma,Tel.-Nummer, etc.

kann man das mit dem Befehl...

ActiveWorkbook.SendMail Recipients:=xxxx

machen, oder geht das nicht??

Lg max

 

@Grabschmayr

Suche in der VB-Editor-Hilfe nach "MsoEnvelope" und "Introduction"
Dort ist ein Beispiel zum Problem.

Mit .Introduction müsstest Du Deine Angaben einfügen können.

Gruss Urs

 

Vorerst mal danke für die rasche Antwort.

Habe gleich nachgesehen und ein wenig herumprobiert.
Nun stellt sich mir die Frage, wie ich z.B. die Funktion SendMail neu deklariere bzw. gibt es denn hier ein Objekt mit dem ich den Body-Teil der E-mail beeinflussen kann?
Introduction = Einführung

mfg max

 

Office wird gelobt, weil seine Anwendungen zusammenarbeiten können. Wenn ich aber nur schon die Probleme Excel<>Outlook sehe, habe ich so meine Zweifel...

Deine Aussage ist nicht ganz klar:
- Willst Du ein Sheet oder das ganze Workbook versenden?
- Als Anhang oder im Body-Text des Mails?

SendMail kann nur als Anhang senden und es ist unmöglich in den Body einen Text einzufügen. Fertig!

Mein Tipp mit der MsoEnvelope funktioniert bei mir. Das Mail enthält dann einen vorgegebenen Begleittext (.Introduction) und anschliessend den Inhalt des Arbeitsblattes (kein Anhang).

Ich habe ein anderes Makro gefunden, das bei mir funktioniert.
Es sendet im Body einen vordefinierten Text und das aktive Arbeitsblatt als Anhang.

Führe es aus. Du musst nur vorher bei strRecipient = "" Deine eigene Mailadresse eingeben.
Dann sendet es Dir das Resultat >

Code:

Option Explicit
Sub Mail_ActiveSheet()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim strIntro As String
Dim strRecipient As String
Dim strSubject As String

strSubject = "XYZ-Projekt - Neueste Daten"
strRecipient = "grabsch@dingsbums.com"      '= Deine Mailadresse
strIntro = "Lieber Herr Qwertz" & Chr(10) & Chr(10) & _
            "Prüfen Sie bitte diese Aufstellung und senden Sie mir Ihren Kommentar per Mail." & Chr(10) & Chr(10) & _
            "Mit bestem Dank und freundlichen Grüssen" & Chr(10) & Chr(10) & _
            "Paul Grabschmayr" & Chr(10) & _
            " mailto:Grabschmayr@DingsBums.com " & Chr(10) & Chr(10) & _
            "DingsBums AG, 50033 DingsBumsen"

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set Sourcewb = ActiveWorkbook
            'Copy the sheet to a new workbook
            'oder Sheets("XYZ-Tabelle").Copy
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook
    FileExtStr = ".xls": FileFormatNum = -4143
             'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)

    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = strRecipient      
            .CC = ""
            .BCC = ""
            .Subject = strSubject   
            .Body = strIntro        
            .Attachments.Add Destwb.FullName
            'You can add other files also like this
            '.Attachments.Add ("C:\test.txt")
            .Send
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

                'Kill die Gesendete Datei
    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Aber alle Lösungen haben einen grossen HAKEN >
Eine oder gar zwei Meldungen erscheinen "Wollen Sie wirklich senden?"
Ich habe keinen Weg gefunden, die Mistviecher wegzubringen, sie kommen ja von Outlook, nicht von Excel...
Vielleicht hast Du eine Idee?

Lesestoff hat es hier, mit einer Fülle von Beispielen >
>>> http://www.rondebruin.nl/sendmail.htm
Wenn die nichts wissen, wer soll es dann...
Sie haben schon ein Modell, das ohne Meldung direkt über den SMTP-Client geht, aber bei mir funktionierte es nicht.

Gruss Urs

 

Danke, danke, danke,...

Das war genau was ich gesucht habe,... und die Internetseite dazu ist der Hammer,...

Vielen, vielen Dank.

mfg max

 

Hast Du die Fragen von Outlook wegbekommen?
Das würde mich auch interessieren...
...oder ist es diesmal keine "Nachtschicht"-Anwendung?

Gruss Urs

 

Ne, diesmal ist es keine "Nachtschicht"-Anwendung.

Aber es kommen bei mir auch vom Outlook keine Fragen mehr.

Gib dir mal den Code:

Code:

Sub Abrechnung_xxx()
'
    Sheets("Bilanz").Select
    Range("A38").Select
    REGISTER = Range("A38")
    Range("A39").Select
    SAVE_xxx = Range("A39")
    Range("A40").Select
    MAIL1 = Range("A40")
    Range("A41").Select
    MAIL2 = Range("A41")
    Range("A42").Select
    BEREICH = Range("A42")
    Range("A1").Select
'
    Sheets("Abrechnung").Select
    Columns("A:A").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValues
    Selection.PasteSpecial Paste:=xlPasteFormats
    Application.CutCopyMode = False
    Sheets("Tabelle1").Select
    Sheets("Tabelle1").Name = REGISTER
    Columns(BEREICH).Select
    Selection.ClearContents
    Selection.EntireColumn.Hidden = True
    Range("C11").Select
    Range("A1").Select
    ActiveWorkbook.SaveAs Filename:=SAVE_xxx, FileFormat:=xlNormal, _
        Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
'
    strSubject = ActiveWorkbook.Name
    strRecipient = MAIL1
    strBody = "Anbei die Abrechnung " & strSubject & "<br><br>" & Chr(10) & Chr(10) & _
            "Mit freundlichen Grüssen<br>"
'
    SigString = "C:\Dokumente und Einstellungen\" & Environ("username") & _
                "\Anwendungsdaten\Microsoft\Signatures\" & Environ("username") & ".htm"
'
    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If
'
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
'
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
'
    With ActiveWorkbook
        On Error Resume Next
        With OutMail
            .To = strRecipient
            .CC = ""
            .BCC = ""
            .Subject = strSubject
'            .Body = strIntro &
            .HTMLBody = strBody & "<br><br>" & Signature
            .Attachments.Add ActiveWorkbook.FullName
            .Send
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With
'
    Set OutMail = Nothing
    Set OutApp = Nothing
'
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
'
    Range("C11").Select
    Range("A1").Select
End Sub

Function GetBoiler(ByVal sFile As String) As String
'
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function

Die Namen sind selbstverständlich ein wenig geändert,...

Lg max

 

Danke für den Code.

Ich habe Dein Sub ausgeführt > Meldung > "Jemand möchte in Ihrem Namen senden --- Ja? oder Nein?"

Alle Outlook-Einstellungen getestet, dem Makro ein (eigenes) Zertifikat verpasst >>> Die Meldung kommt!
Möglicherweise arbeitet Dein Outlook mit MS Exchange Server, wo andere Regeln gültig/einstellbar sein könnten...
Oder Dein Office2003 ist noch nicht SP3...

Auch mit SendKeys oder ähnlichen Dingern ist nichts zu machen... wäre ja auch zu dumm, wenn sich die schöne "Sicherheit" so leicht aushebeln lassen würde.
Aber macht nichts, ich habe keine ""Nachtschicht"-Programme.

Gruss Urs

 

hi,...

ich verwende zwar "MS Exchange Server", aber mir sind hier keine sonderbaren Regeln oder dergleichen bekannt,...

Was vielleicht ausschlaggebend ist, ist, dass ich vor kurzem auf Outlook 2007 umgestiegen bin.

Kommt eigentlich nur die Meldung "Jemand möchte in Ihrem Namen senden --- Ja? oder Nein?"...???
Dann könnt ich mir vorstellen, dass es daran liegt, das mein Script sich die Signatur des Benutzers holt und einfügt. Sind auf deinem PC mehrere Benutzer bzw. Signaturen vorhanden?

mfg max

 

Hi Max,

Ja es kommt nur diese Meldung, Dein Script funktioniert perfekt, ausser dass Outlook wissen will, ob es senden darf.
Die Signatur hatte ich deaktiviert.

Ich habe noch ein bisschen herum geforscht, es scheint tatsächlich mit Exchange Server zusammenzuhängen. Der bestätigt Outlook offenbar, dass Dein PC (wo es ja selbst drauf ist!) ein seriöses Mitglied seiner Familie sei.

Bei meinem PC muss ich die Arbeit von Exchange wohl selbst übernehmen und "Ja" klicken...

Mit Outlook Express soll es funktionieren, das ist wohl weniger seriös, bei Bedarf werde ich das dann erforschen.

Gruss Urs