Hoofdmenu

CrYpTo

Programming

Linux

Azure

Windows Client

Windows Server

Office

Hyper-V

Update

Legacy

Home : PC-tips : Mailen van uit excel via MACRO

BRON: http://www.snb-vba.eu/VBA_Excelgegevens_mailen.html
LET OP: Ik heb deze tekst letterlijk overgenomen van bovenstaande site. 

Excelgegevens (werkboek, werkblad, gebied) mailen

Je kunt Excelgegevens met verschillende methoden mailen:

- sendmail
- circulatielijst (routingslip)
- via Outlook
Welke methode je kiest is afhankelijk van of je de emailgegevens in de mail zelf wil opnemen, of dat je ze als bijlage wil sturen.
De keuze is ook afhankelijk van je versie van Excel: de methode 'met circulatielijst' (routingslip) is niet meer beschikbaar sinds Excel 2007; Excel 2000 en 2003 bevatten die methode wel.

In veel gevallen voldoet de eenvoudige methode 'Sendmail'. 
Met de circulatielijst heb je de beschikking over faciliteiten die geen enkele andere methode bevat (sequentieel doorsturen, het doorstuurproces volgen, automatische terugzending van gewijzigde/gecorrigeerde bijlagen).
Als je Outlook gebruikt heb je de beschikking over eigenschappen als BCC, CC etc.

Als je Outlook gaat gebruiken moet je iets meer weten hoe je met VBA kontakt kunt leggen met Outlook.
Hieronder een korte uitleg.
De voorbeeldcode gebruikt steeds de methode CreateObject("Outlook.Application")

De voorbeeldcode laat zien hoe je met de verschillende methoden:
- een heel werkboek kunt versturen
- een integraal werkblad kunt versturen
- alleen de waarden van een werkblad kun versturen
- een gebied (Range) an een werkblad kunt versturen
- alleen de waarden van een gebied (Range) kunt versturen

Toegang tot Outlook

Er zijn 3 methoden om vanuit Excel toegang te krijgen tot Outlook:

I. Outlook is niet geladen

   de methode CreateObject

with CreateObject("Outlook.Application")
x=.GetNamespace("MAPI").GetDefaultFolder(6).Items.count
End With

   Beperking:
   De 'CreateObject'-methode herkent Outlook typenamen niet, alleen de Outlookconstanten.
   Bijvoorbeeld: de typenaam van map 'PostvakIN' is in VBA olFolderInbox; de Outlookcontante voor deze map is 6.

x=CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items.count

   Levert dan ook een fout op.

II. Outlook is geladen

   de methode Getobject

With Getobject(,"Outlook.Application")
x=.GetNamespace("MAPI").GetDefaultFolder(6).Items.Count
End With

   De methode 'GetObject' kent dezelfde beperking voor typenamen als de methode 'CreateObject'.

III. Outlook-VBA-bibliotheek laden

   de methode 'references': onafhankelijk of Outlook is geladen.
   handmatig: VBEditor/ Menubalk / Extra / Verwijzingen / Microsoft Outlook 11.0 Object Library /aanvinken

sub referentie()
ThisWorkbook.VBProject.References.AddFromFile "msoutl9.olb"   ' Outlook 2000
ThisWorkbook.VBProject.References.AddFromFile "msoutl10.olb"   ' Outlook 2003
ThisWorkbook.VBProject.References.AddFromFile "msoutl11.olb"   ' Outlook 2007
End sub

   daarna kun je outlook als object gebruiken in de code

with Outlook
x=.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items.Count
end with

   Bij deze methode kun je zowel gebruik maken van de Outlook typenames als de Outlookconstanten.

De voorbeeldcode maakt gebruik van de Methode 'CreateObject'.

I Excelgegevens opnemen in het emailbericht

Als je de Excelgegevens wil opnemen in het emailbericht zelf (in de 'Body') moet je gebruik maken van Outlook.
Je kunt in ieder emailbericht HTML-gegevens plaatsen.
Dat kunnen ook gegevens uit een Excel bestand zijn.
Dat kan het hele werkboek zijn of delen van een Excelbestand (werkblad, gebied, rij, kolom of cel).
Daarvoor moet je de Excelgegevens eerst naar HTML converteren.
Alle opmaakkenmerken van Excel gaan daarbij verloren; alleen waarden in werkbladen worden opgenomen.

Het volledige werkboek in het bericht

Sub volledig_werkboek_in_email()
c01 ="<table border=1 bgcolor=#FFFFF0#>"

For Each sh In Sheets
sn = sh.UsedRange
For j = 1 To UBound(sn)
c01 = c01 & "<tr><td>" & Join(Application.Index(sn, j), "</td><td>") & "</td></tr>"
Next
c01 = c01 & "</table><P></P><P></P>"
Next

With CreateObject("Outlook.Application").CreateItem(0)
.To = " This email address is being protected from spambots. You need JavaScript enabled to view it. "
.Subject = "werkbladen"
.HTMLBody = c01
.Send
End With
End Sub

De waarden van 1 werkblad in het bericht

Sub werkblad_waarden_in_email()
c01 = "<table border=1 bgcolor=#FFFFF0#>"

sn = Sheets("Blad1").UsedRange
For j = 1 To UBound(sn)
c01 = c01 & "<tr><td>" & Join(Application.Index(sn, j), "</td><td>") & "</td></tr>"
Next
c01 = c01 & "</table><P></P><P></P>"

With CreateObject("outlook.application").CreateItem(0)
.To = " This email address is being protected from spambots. You need JavaScript enabled to view it. "
.Subject = "werkbladwaarden"
.HTMLBody = c01
.Send
End With
End Sub

De formules van 1 werkblad in het bericht

Sub werkblad_formules_in_email()
c01 = "<table border=1 bgcolor=#FFFFF0#>"

sn = Sheets("Blad1").UsedRange.Formula
For j = 1 To UBound(sn)
c01 = c01 & "<tr><td>" & Join(Application.Index(sn, j), "</td><td>") & "</td></tr>"
Next
c01 = c01 & "</table><P></P><P></P>"

With CreateObject("Outlook.Application").CreateItem(0)
.To = " This email address is being protected from spambots. You need JavaScript enabled to view it. "
.Subject = "werkbladformules"
.HTMLBody = c01
.Send
End With
End Sub

Waarden van een gebied (Range) in het bericht

Sub range_waarden_in_email()
c01 = "<table border=1 bgcolor=#FFFFF0#>"

sn = Sheets("Blad1").Range("A1:K100")
For j = 1 To UBound(sn)
c01 = c01 & "<tr><td>" & Join(Application.Index(sn, j), "</td><td>") & "</td></tr>"
Next
c01 = c01 & "</table><P></P><P></P>"

With CreateObject("Outlook.Application").CreateItem(0)
.To = " This email address is being protected from spambots. You need JavaScript enabled to view it. "
.Subject = "werkbladgebied waarden"
.HTMLBody = c01
.Send
End With
End Sub

De formules van een gebied in het bericht

Sub range_formules_in_email()
c0 = "<table border=1 bgcolor=#FFFFF0#>"

sn = Sheets("Blad1").Range("A1:K100").Formula
For j = 1 To UBound(sn)
c01 = c01 & "<tr><td>" & Join(Application.Index(sn, j), "</td><td>") & "</td></tr>"
Next
c01 = c01 & "</table><P></P><P></P>"

With CreateObject("Outlook.Application").CreateItem(0)
.To = " This email address is being protected from spambots. You need JavaScript enabled to view it. "
.Subject = "werkbladgebied formules"
.HTMLBody = c01
.Send
End With
End Sub

II Excelgegevens (werkboek, werkblad, gebied) versturen als bijlage

- methode 'Sendmail'
- methode circualtielijst (Routingslip)
- met Outlook

IIa De methode SendMail

Werkboek met 1 geadresseerde

Sub mail_werkboek_met_sendmail()
ActiveWorkbook.SendMail " This email address is being protected from spambots. You need JavaScript enabled to view it. ", "onderwerp"
End Sub

Werkboek naar meer geadresseerden

Sub mail_werkboek_met_sendmail_adressen()
ActiveWorkbook.SendMail Array(" This email address is being protected from spambots. You need JavaScript enabled to view it. ", " This email address is being protected from spambots. You need JavaScript enabled to view it. "), "onderwerp"
End Sub

Werkboek naar adressen uit een werkboek

- Emailgegevens in een werkblad kun je rechtstreeks aan het argument 'recipients' toewijzen.
  Gegevens uit een kolom (A1:A10), rij (A1:K1) of gebied (A1:K10) worden automatisch in een 1-dimensionele matrix gezet.

Sub mail_werkboek_met_sendmail_adressen()
With ActiveWorkbook
.SendMail .sheets(1).Range("A1:G10"), "onderwerp"
End With
End Sub

Werkblad integraal

Sub mail_werkblad_integraal_met_sendmail()
With ActiveWorkbook
.Sheets(1).Copy

with ActiveWorkbook
.SendMail " This email address is being protected from spambots. You need JavaScript enabled to view it. ", "onderwerp"
.Close False
End With
End With
End Sub

Waarden in werkblad

Sub mail_werkblad_waarden_met_sendmail()
With ActiveWorkbook
With .Sheets.Add
.Cells = ActiveWorkbook.Sheets(1).Cells.Value
.Copy

with ActiveWorkbook
.SendMail " This email address is being protected from spambots. You need JavaScript enabled to view it. ", "onderwerp"
.Close False
End With

.Delete
End With
End With
End Sub

Werkblad zonder VBA

Sub mail_werkblad_waarden_met_sendmail()
With ActiveWorkbook
With .Sheets.Add
ActiveWorkbook.Sheets(1).Cells.Copy .Cells(1)
.Copy

with ActiveWorkbook
.SendMail " This email address is being protected from spambots. You need JavaScript enabled to view it. ", "onderwerp"
.Close False
End With

.Delete
End With
End With
End Sub

Gebied (Range) integraal

Sub mail_gebied_integraal_met_sendmail()
With ActiveWorkbook
With .Sheets.Add
ActiveWorkbook.Sheets(1).Range("A1:K25").Copy .Cells(1)
.Copy

with ActiveWorkbook
.SendMail " This email address is being protected from spambots. You need JavaScript enabled to view it. ", "onderwerp"
.Close False
End With

.Delete
End With
End With
End Sub

Waarden in gebied (Range)

Sub mail_gebied_waarden_met_sendmail()
With ActiveWorkbook
With .Sheets.Add
.range("A1:K25") = ActiveWorkbook.Sheets(1).Range("A1:K25").Value
.Copy

with ActiveWorkbook
.SendMail " This email address is being protected from spambots. You need JavaScript enabled to view it. ", "onderwerp"
.Close False
End With

.Delete
End With
End With
End Sub

IIb Gebruik van een circulatielijst

Ben je in het gelukkige bezit van Excel 2000 of 2003 dan beschik je over een van de handigste samenwerkingsfaciliteiten van Office: de circulatielijst.
Daarmee kun je ieder officedocument versturen naar 1 of meer geadresseerden via je standaard-emailprogramma.

Extra's bij deze faciliteit zijn:
- de keuze of je het document naar alle geadresseerden tegelijkertijd (Delivery: xlAllAtOnce) wil sturen, of dat je wil dat ze het na opening/wijziging automatisch naar de volgende in de lijst (Delivery: xlOneAfterAnother) doorsturen.
- keuze of je bij het sequentieel doorsturen van het document een melding van die doorstuuraktie wil krijgen (Trackstatus=True)
- keuze of je wil dat alle geadresseerden hun geopende/gewijzigde bestanden naar je terugsturen (ReturnWhenDone = True)

De ontvanger krijgt na opening/wijziging van het bestand bij sluiting automatisch de vraag:
- om het bestand naar de afzender terug t sturen (ReturnWhenDone)
- om het bestand door te sturen naar de volgende geadresseerde in de circulatielijst (delivery: xlOneAfterAnother).
Een klik op de OK knop volstaat.
Het is onbegrijpelijk dat MS deze circuatielijstfaciliteit uit Office 2007 heeft gesloopt.

Werkboek naar 1 geadresseerde

Sub mail_werkboek_met_circulatielijst()
With ActiveWorkbook
.HasRoutingSlip = True

With .RoutingSlip
.Recipients = " This email address is being protected from spambots. You need JavaScript enabled to view it. "
.Subject = "Onderwerp"
.Message = "dit is het bericht"
.Delivery = xlAllAtOnce
.ReturnWhenDone = True
.TrackStatus = False
End With
.Route
End With
End Sub

Werkboek naar meer geadresseerden

Sub mail_werkboek_met_circulatielijst()
With ActiveWorkbook
.HasRoutingSlip = True

With .RoutingSlip
.Recipients = Array(" This email address is being protected from spambots. You need JavaScript enabled to view it. ", " This email address is being protected from spambots. You need JavaScript enabled to view it. ")
.Subject = "Onderwerp"
.Message = "dit is het bericht"
.Delivery = xlOneAfterAnother
.ReturnWhenDone = True
.TrackStatus = False
End With
.Route
End With
End Sub

Werkboek naar adressen uit een werkblad

- Emailgegevens in een werkblad kun je rechtstreeks aan de eigenschap recipients toewijzen.
  Gegevens uit een kolom (A1:A10), rij (A1:K1) of gebied (A1:K10) worden automatisch in een 1-dimensionele matrix gezet.

Sub mail_werkboek_met_circulatielijst()
With ActiveWorkbook
.HasRoutingSlip = True

With .RoutingSlip
.Recipients = sheets(1).range("A1:K10")
.Subject = "Onderwerp"
.Message = "dit is het bericht"
.Delivery = xlOneAfterAnother
.ReturnWhenDone = True
.TrackStatus = False
End With
.Route
End With
End Sub

Werkboek zonder VBA

Sub werkboek_zonder_VBA_met_circulatielijst()
With Workbooks.Add
For Each sh In ThisWorkbook.Sheets
With .Sheets.Add
.Name = "c_" & sh.Name
sh.Cells.Copy .Cells(1)
End With
Next

.HasRoutingSlip = True
With .RoutingSlip
.Recipients = " This email address is being protected from spambots. You need JavaScript enabled to view it. "
.Subject = "Onderwerp"
.Message = "dit is het bericht"
.Delivery = xlAllAtOnce
.ReturnWhenDone = False
End With
.Route

.Close False
End With
End Sub

Werkblad integraal

Sub mail_werkblad_met_circulatielijst()
With ActiveWorkbook
.sheets(1).copy

With activeworkbook
.HasRoutingSlip = True
With .RoutingSlip
.Recipients = " This email address is being protected from spambots. You need JavaScript enabled to view it. "
.Subject = "Onderwerp"
.Message = "dit is het bericht"
.Delivery = xlAllAtOnce
.ReturnWhenDone = False
End With
.Route
End With
End With
End Sub

Werkblad zonder VBA

Sub mail_werkblad_zonder_VBA_met_circulatielijst()
With ActiveWorkbook
with .Sheets.Add
Activeworkbook.Sheets(1).Cells.Copy .Cells(1)
.Copy
With ActiveWorkbook
.HasRoutingSlip = True
With .RoutingSlip
.Recipients = " This email address is being protected from spambots. You need JavaScript enabled to view it. "
.Subject = "Onderwerp"
.Message = "dit is het bericht"
.Delivery = xlAllAtOnce
.ReturnWhenDone = False
End With
.Route
.Close False
End With
.Delete
End With
End With
End Sub

 

Gebied integraal

Sub mail_gebied_met_circulatielijst()
With ActiveWorkbook
With .Sheets.Add
Activeworkbook.Sheets(1).Cells(1).CurrentRegion.Copy .Cells(1)
.Copy
With activeworkbook
.HasRoutingSlip = True
With .RoutingSlip
.Recipients = " This email address is being protected from spambots. You need JavaScript enabled to view it. "
.Subject = "Onderwerp"
.Message = "dit is het bericht"
.Delivery = xlAllAtOnce
.ReturnWhenDone = False
End With
.Route
.Close False
End With
.Delete
End With
End With
End Sub

IIc Excelgegevens (werkboek, werkblad, gebied) versturen met Outlook

Je kunt aan ieder emailbericht in Outlook een bijlage (attachment) toevoegen.
Dat kan een Excel bestand zijn.
Je kunt delen van een Excelbestand (werkblad, grafiek, gebied, range) niet als bijlage meesturen.
Je moet zo'n element eerst als Excelbestand (werkboek) opslaan, daarna kun je het aan een emailbericht toevoegen.

In Excelversies < 2007 hoefde je bij het opslaan van een bestand de extensie en het 'fileformat' niet expliciet op te geven. Sinds Excel 2007 moet dat wel.
In de voorbeeldcode gaan we ervan uit dat de te verzenden bijlage dezelfde extensie en hetzelfde fileformat krijgt als het bestand waaruit de gegevens afkomstig zijn.
Gebruik de voorbeeldcode daarom alleen in een bestand dat al opgeslagen (met pad en extensie) is.

Het volledige werkboek

Sub volledig_werkboek_sturen()
With CreateObject("Outlook.Application").createitem(0)
.to = " This email address is being protected from spambots. You need JavaScript enabled to view it. "
.Subject = "example"
.attachments.Add ThisWorkbook.FullName
.Send
End With
End Sub

Werkblad integraal

- kopieer het werkblad
- sla het automatisch gecre‰erde werkboek op
- voeg het als attachment aan de email toe

Sub enkel_werkblad_integraal_sturen()
Application.DisplayAlerts = False

c00 = "E:\OF\bestandsnaam." & CreateObject("scripting.filesystemobject").getextensionname(ThisWorkbook.Name)
c01 = ThisWorkbook.FileFormat

ThisWorkbook.Sheets("Blad1").Copy

With ActiveWorkbook
.SaveAs c00, c01
.Close False
End With

With CreateObject("Outlook.Application").createitem(0)
.to = " This email address is being protected from spambots. You need JavaScript enabled to view it. "
.Subject = "example"
.attachments.Add c00
.Send
End With
End Sub

Waarden van een werkblad

- maak een nieuw tijdelijk werkblad
- zet hierin de waarden van het te verzenden werkblad
- kopieer dit tijdelijke werkblad zodat het een nieuw werkboek wordt
- sla dit nieuwe werkboek op als Excel-bestand
- verwijder het tijdelijke werkblad
- voeg het nieuwe werkboek als bijlage toe aan de email

Sub enkel_werkblad_alleen_waarden_sturen()
Application.DisplayAlerts = False

c00 = "E:\OF\bestandsnaam." & CreateObject("scripting.filesystemobject").getextensionname(ThisWorkbook.Name)
c01 = ThisWorkbook.FileFormat

With ThisWorkbook.Sheets.Add
.Range(ThisWorkbook.Sheets("Blad1").UsedRange.Address) = ThisWorkbook.Sheets("Blad1").UsedRange.Value
.Copy

With ActiveWorkbook
.SaveAs c00, c01
.Close False
End With

.Delete
End With

With CreateObject("Outlook.Application").createitem(0)
.to = " This email address is being protected from spambots. You need JavaScript enabled to view it. "
.Subject = "example"
.attachments.Add c00
.Send
End With
End Sub

Werkblad zonder VBA-code

- maak een nieuw tijdelijk werkblad
- kopieer hierin alle cellen van het te verzenden werkblad
- kopieer dit tijdelijke werkblad zodat het een nieuw werkboek wordt
- sla dit nieuwe werkboek op als Excel-bestand
- verwijder het tijdelijke werkblad
- voeg het nieuwe werkboek toe als bijlage aan de email

Sub enkel_werkblad_zonder_VBA_sturen()
Application.DisplayAlerts = False

c00 ="E:\OF\bestandsnaam." & CreateObject("scripting.filesystemobject").getextensionname(ThisWorkbook.Name)
c01 = ThisWorkbook.FileFormat

With ThisWorkbook.Sheets.Add
ThisWorkbook.Sheets("Blad1").Cells.Copy .Cells(1)
.Copy

With ActiveWorkbook
.SaveAs c00, c01
.Close False
End With

.Delete
End With

With CreateObject("Outlook.Application").createitem(0)
.to = " This email address is being protected from spambots. You need JavaScript enabled to view it. "
.Subject = "example"
.attachments.Add c00
.Send
End With
End Sub

Verschillende werkbladen integraal

- sla het bestand als kopie onder nieuwe naam op
- open het nieuwe bestand
- verwijder de werkbladen die niet verzonden moeten worden
- sla het bestand op
- voeg dit bestand toe als bijlage aan de email

Sub verschillende_werkbladen_integraal_sturen()
Application.DisplayAlerts = False

c00 = "E:\OF\bestandsnaam." & CreateObject("scripting.filesystemobject").getextensionname(ThisWorkbook.Name)
c01 = ThisWorkbook.FileFormat
sn = Split("weg1|weg2|weg3", "|")

ThisWorkbook.SaveCopyAs c00

With GetObject(c00)
.Sheets(sn).Delete
.Close True
End With

With CreateObject("Outlook.Application").createitem(0)
.to = " This email address is being protected from spambots. You need JavaScript enabled to view it. "
.Subject = "example"
.attachments.Add c00
.Send
End With
End Sub

Een gebied (Range) integraal (inclusief opmaak, formules, etc.)

- maak een nieuw tijdelijk werkblad
- kopieer hierin het te verzenden gebied
- kopieer dit tijdelijke werkblad zodat het een nieuw werkboek wordt
- sla dit nieuwe werkboek op als Excel-bestand
- verwijder het tijdelijke werkblad
- voeg het nieuwe werkboek als bijlage toe aan de email

Sub Range_integraal()
Application.DisplayAlerts = False
Application.ScreenUpdating = False

c00 = "E:\OF\bestandsnaam." & CreateObject("scripting.filesystemobject").getextensionname(ThisWorkbook.Name)
c01 = ThisWorkbook.FileFormat

With ActiveWorkbook.Sheets.Add
ActiveWorkbook.Sheets("Blad1").Range("A1:AC152").Copy .Range("A1")
.Copy

With ActiveWorkbook
.SaveAs c00, c01
.Close
End With

.Delete
End With

With CreateObject("Outlook.Application").CreateItem(0)
.To = " This email address is being protected from spambots. You need JavaScript enabled to view it. "
.Subject = "example"
.Attachments.Add c00
.Send
End With
End Sub

Waarden van een gebied (Range)

- maak een nieuw tijdelijk werkblad
- zet hierin de waarden van het te verzenden gebied
- kopieer dit tijdelijke werkblad zodat het een nieuw werkboek wordt
- sla dit nieuwe werkboek op als Excel-bestand
- verwijder het tijdelijke werkblad
- voeg het nieuwe werkboek toe als bijlage aan de email

Sub Range_alleen_waarden()
Application.DisplayAlerts = False
Application.ScreenUpdating = False

c00 = "E:\OF\bestandsnaam." & CreateObject("scripting.filesystemobject").getextensionname(ThisWorkbook.Name)
c01 = ThisWorkbook.FileFormat
c02 = "Blad1"
c03 = "A1:AC152"

With ActiveWorkbook.Sheets.Add
.Range(c03) = ActiveWorkbook.Sheets(c02).Range(c03).Value
.Copy

With ActiveWorkbook
.SaveAs c00, c01
.Close
End With

.Delete
End With

With CreateObject("Outlook.Application").createitem(0)
.To = " This email address is being protected from spambots. You need JavaScript enabled to view it. "
.Subject = "example"
.Attachments.Add c00
.Send
End With
End Sub

reclame

Close










 

 

  

  		 

 

  

 

 
             
             

 

Copyright © 2000 - . All Rights Reserved | J. Marbus.