Ga naar inhoud

[macro] e-mail sturen met excel - probleempje


Aanbevolen berichten

In het Excel document heb ik al een macro die automatisch een bereik uit het Excel werkblad opslaat als PDF. Deze PDF krijgt dezelfde naam als het Excel document. Ook heb ik nu dankzij [URL="http://www.schoonepc.nl/nieuwsbrief/tips_versturen_facturen_email.html"]deze link[/URL] een macro die een e-mailbericht opent en daar een bepaalde tekst aan toevoegd. Echter wil ik ook het volgende: - Ik wil nu dat hij de opgeslagen PDF aan de e-mail toevoegt. Ik heb nu even een standaard file op mijn pc daar neer gezet, maar die neemt hij al niet op in het e-mailbericht.... - Ook wil ik dat hij in plaats van de voorgedefinieerde "strbody" in de macro een handtekening in Outlook als body plaatst. Hier vind ik geen code voor? - Daarbij wil ik dat hij als subject de inhoud van de cellen C10 en D10 neemt. Dit doet hij ook niet. Dit krijg ik niet voor elkaar. Ik krijg alleen een nieuwe e-mail, met de voorgedefinieerde strbody tekst. Ik heb tot nu toe dit: [quote:b8ad09cff2]Sub Mail_Range() 'Working in 2000-2010 Dim Source As Range Dim Dest As Workbook Dim wb As Workbook Dim TempFilePath As String Dim TempFileName As String Dim FileExtStr As String Dim FileFormatNum As Long Dim OutApp As Object Dim OutMail As Object Set Source = Nothing On Error Resume Next Set Source = Range("B2:M55").SpecialCells(xlCellTypeVisible) On Error GoTo 0 If Source Is Nothing Then MsgBox "The source is not a range or the sheet is protected, " & _ "please correct and try again.", vbOKOnly Exit Sub End If With Application .ScreenUpdating = False .EnableEvents = False End With Set wb = ActiveWorkbook Set Dest = Workbooks.Add(xlWBATWorksheet) Source.Copy With Dest.Sheets(1) .Cells(1).PasteSpecial Paste:=8 .Cells(1).PasteSpecial Paste:=xlPasteValues .Cells(1).PasteSpecial Paste:=xlPasteFormats .Cells(1).Select Application.CutCopyMode = False End With TempFilePath = Environ$("temp") & "\" TempFileName = "Selection of " & wb.Name & " " _ & Format(Now, "dd-mmm-yy h-mm-ss") If Val(Application.Version) < 12 Then 'You use Excel 2000-2003 FileExtStr = ".xls": FileFormatNum = -4143 Else 'You use Excel 2007-2010 FileExtStr = ".pdf": FileFormatNum = 51 End If Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) strbody = "Goedemorgen," & vbNewLine & vbNewLine & _ "Graag bieden wij u de volgende offerte aan volgens de door u opgegeven specificaties." & vbNewLine & vbNewLine & _ "De offerte vind u in de bijlagen van deze e-mail." & vbNewLine & vbNewLine & _ "Met vriendelijke groet," & vbNewLine & vbNewLine & _ "Dennis Geenen" & vbNewLine & _ "Directeur" With Dest .SaveAs TempFilePath & TempFileName & FileExtStr, _ FileFormat:=FileFormatNum On Error Resume Next .Subject = ActiveSheet.Range("C10") With OutMail .To = "" .CC = "" .BCC = "" .Subject = Subject .Attachments.Add "C:\Users\Public\Documents\e-maillijst nieuwsbrief januari" .Body = strbody .Display 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 End Sub [/quote:b8ad09cff2]
Link naar reactie

Om een reactie te plaatsen, moet je eerst inloggen

Gast
Reageer op dit topic

×   Geplakt als verrijkte tekst.   Herstel opmaak

  Er zijn maximaal 75 emoji toegestaan.

×   Je link werd automatisch ingevoegd.   Tonen als normale link

×   Je vorige inhoud werd hersteld.   Leeg de tekstverwerker

×   Je kunt afbeeldingen niet direct plakken. Upload of voeg afbeeldingen vanaf een URL in

×
×
  • Nieuwe aanmaken...