Signature in mail verzending

Status
Niet open voor verdere reacties.

resmatrix

Gebruiker
Lid geworden
6 nov 2006
Berichten
173
goedemiddag

ik gebruik onderstaande code. werkt prima

de enige vraag die ik heb kan bij het verzenden van de email ook de outlook signature geselecteerd worden en hoe?

hoop dat jullie kunnen helpen

Code:
Sub sendmail()
    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

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

    Set Sourcewb = ActiveWorkbook

    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook

    With Destwb
        If Val(Application.Version) < 12 Then
            
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            
            Select Case Sourcewb.FileFormat
            Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
            Case 52:
                If .HasVBProject Then
                    FileExtStr = ".xlsm": FileFormatNum = 52
                Else
                    FileExtStr = ".xlsx": FileFormatNum = 51
                End If
            Case 56: FileExtStr = ".xls": FileFormatNum = 56
            Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
            End Select
        End If
    End With

    TempFilePath = Environ$("temp") & "\"
    TempFileName = "xxxxxxxxxxxxxxxxx" & " " & Range("F3").Value & " " & Format(Now, "dd-mmm-yy")

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

    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .to = Range("AX16").Value
            .CC = Range("AX18").Value
            .BCC = "xxxxxx"
            .Subject = Range("E54").Value & " " & "for" & " " & Range("F3").Value
            .Body = "xxxxxxx," & vbNewLine & _
            vbNewLine & _
            "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx " & Range("E54").Value & vbNewLine & _
            "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" & vbNewLine & _
            vbNewLine & _
            "This message is automatically generated" & vbNewLine & _
            vbNewLine & _
            vbNewLine & _
            "xxxxxxxxxxxxxxx," & vbNewLine & _
            vbNewLine & _
            vbNewLine


            .Attachments.Add Destwb.FullName

            .Send
        End With
        On Error GoTo 0
        .Close savechanges:=False
    End With


    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    MsgBox "E-mail has succesfully been send!"
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan