Actieve sheet direct verzenden via Outlook

[Stephandejong]

Hallo,

Ik ben aan het zoeken geweest om een VBA code te vinden die ik aan een button kan hangen om de actieve sheet in Excel direct te versturen door alleen op de knop te drukken.
Ik kom er maar niet uit hoe ik dit voor elkaar krijg.

Kan iemand mij hiermee helpen?

 

[richard1970]

Beste Stephan,

Kijk eens op de site van Ron de Bruijn bij mailen: http://www.rondebruin.nl/win/section1.htm

Richard

 

[Gert Bouwmeeste]

Hallo Stephan,

Naast de door Richard aangeraden site van Ron de Bruijn vind je op deze site van SNB ook veel voorbeelden.

Bijgaand Excelbestand bevat een macro waarmee het bestand (een factuur) eerst als PDF wordt opgeslagen en daarna als PDF wordt gemaild. Macrocode:

Sub Mailfactuur()
  
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
        
    Pad = "G:\DATA\"            'Map waar de te verzenden bestanden staan
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    Calculate
    
    Ontvanger = [K5].Value      'Inlezen gegevens uit Excel-bestand
    KopieNaam = [K6].Value
    BlindeKopieNaam = [K7].Value
    Onderwerp = [K8].Value
    Aanhef = [K11].Value
    Tekst = [K13].Value
    Afsluiting = [K19].Value
    Bestand = [K3].Value
        
      
    If Dir(Bestand) <> "" Then
        MsgBox "Het bestand: " & Bestand & ".pdf bestaat reeds"   ' Een controle om geen dubbel PDF-bestand te maken.
        Exit Sub  'Verlaat de routine als het PDF-bestand reeds bestaat.
     Else
    End If
    
    ActiveWorkbook.Save   'Bewaar het Excel-bestand
                                                                    'Exporteer het Excel-bestand naar PDF-formaat (het afdrukbare gebied)
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    Bestand, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
      
     
    With OutMail                                                    'Maak het mailtje aan
        .To = Ontvanger
        .CC = KopieNaam
        .BCC = BlindeKopieNaam
        .Subject = Onderwerp
        .Body = Aanhef & vbCr & vbLf & vbLf & _
                Tekst & vbCr & vbLf & vbLf & _
                Afsluiting
                
        .Attachments.Add Bestand
                
        .DeferredDeliveryTime = FactDatum & " 05:00"  'Stel verzenddatum uit tot tijdstip dat je meegeeft
        .ReadReceiptRequested = True                  'Ontvanstbevestiging = Aan
        .ReplyRecipientNames = ""                     'Eventueel afwijkend mailadres voor antwoorden.

        .Display    'Laat m in Outlook zien voor verzenden
        '.Send      'Verstuurt m meteen
        '.Save      'Bewaart m in de standaardmap voor concepten, verstuurt niet.
        
    End With
    
    Set OutMail = Nothing
    Set OutApp = Nothing
    Ontvanger = ""
    KopieNaam = ""
    BlindeKopieNaam = ""
    Onderwerp = ""
    Aanhef = ""
    Tekst = ""
    Afsluiting = ""
    Bestand = ""

End Sub