rmanders1945
Gebruiker
- Lid geworden
- 26 feb 2016
- Berichten
- 15
Hoi,
ik heb reeds eerder een zeer goede oplossing van jullie ontvangen betreffende email vba Outlook en Sendkeys.
Nu zou ik graag de email willen plaatsen via vba naar de map Concepten in Outlook.
Ik heb onderstaande vba voor de email.
Is het mogelijk om deze direct in de Concepten map te plaatsen ?
Alvast ontzettend bedankt voor de genomen moeite,
Rob
Sub FaktEmailenAlsPDF3()
Dim Bestand As String
Dim OutApp As Object
Dim OutMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Sheets("Aantekeningen").Unprotect
Sheets("Aantekeningen").Range("N13").Value = 0 '' als er iets fout gaat wordt het 1
directory = Sheets("Aantekeningen").Range("N5").Value
emailadres = "" & Sheets("VerkoopFaktuur").Range("AA4").Value ''emailadres
naamlid = Sheets("VerkoopFaktuur").Range("E7").Value ''voornaam en achternaam
Filename = directory & " " & naamlid & " "
'' "C:\Users\Fakturen" 'De locatie van de bijlage
Bestand = Filename & ".pdf"
''Bestand = Environ("TEMP") & "" & ActiveSheet.Name & ".pdf"
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=Bestand
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = emailadres
.CC = ""
.BCC = ""
.Subject = "Factuur"
.Body = "Factuur"
.Attachments.Add Bestand
.Display
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%z" '' z voor nederlandse versie outlook s voor engelse versie
'' .Send
End With
On Error GoTo fout
Kill Bestand
GoTo verder
fout:
MsgBox " niet verzonden ! "
Set OutMail = Nothing
Set OutApp = Nothing
Sheets("Faktuur").Select
Sheets("Aantekeningen").Range("C1").Value = 1
verder:
Call SetNumLockOn
End Sub
ik heb reeds eerder een zeer goede oplossing van jullie ontvangen betreffende email vba Outlook en Sendkeys.
Nu zou ik graag de email willen plaatsen via vba naar de map Concepten in Outlook.
Ik heb onderstaande vba voor de email.
Is het mogelijk om deze direct in de Concepten map te plaatsen ?
Alvast ontzettend bedankt voor de genomen moeite,
Rob
Sub FaktEmailenAlsPDF3()
Dim Bestand As String
Dim OutApp As Object
Dim OutMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Sheets("Aantekeningen").Unprotect
Sheets("Aantekeningen").Range("N13").Value = 0 '' als er iets fout gaat wordt het 1
directory = Sheets("Aantekeningen").Range("N5").Value
emailadres = "" & Sheets("VerkoopFaktuur").Range("AA4").Value ''emailadres
naamlid = Sheets("VerkoopFaktuur").Range("E7").Value ''voornaam en achternaam
Filename = directory & " " & naamlid & " "
'' "C:\Users\Fakturen" 'De locatie van de bijlage
Bestand = Filename & ".pdf"
''Bestand = Environ("TEMP") & "" & ActiveSheet.Name & ".pdf"
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=Bestand
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = emailadres
.CC = ""
.BCC = ""
.Subject = "Factuur"
.Body = "Factuur"
.Attachments.Add Bestand
.Display
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%z" '' z voor nederlandse versie outlook s voor engelse versie
'' .Send
End With
On Error GoTo fout
Kill Bestand
GoTo verder
fout:
MsgBox " niet verzonden ! "
Set OutMail = Nothing
Set OutApp = Nothing
Sheets("Faktuur").Select
Sheets("Aantekeningen").Range("C1").Value = 1
verder:
Call SetNumLockOn
End Sub