Dank je wel Leo,
Ik heb de hele dag zitten zoeken, maar ben er wel uitgekomen.
Wellicht kan ik met de code iemand helpen die ook naar dit op zoek is.
Met deze code kan ik mailen met een ander account wat op mijn computer staat.
Met deze code verstuur ik een htlm handtekening met plaatje.
Ik kreeg eerst of alleen met handtekening voor elkaar, of alleen met een ander account. tegelijk ging niet.
De oplossing lag in:
.Display
Deze moet ook bovenaan staan, anders ging het niet.
Ik weet niet of iemand er iets aan heeft anders verwijderen de moderators het wel.
Grt Tonnie
Oja die Ranges die overal staan, verwijzen naar gegevens op mijn werkblad, en kunnen weggehaald worden. Ik vind het makkelijk als leek, dan kun je zien wat er allemaal mogelijk is om in te voeren.
Sub Mail_opdracht_vanuit_een_ander_account()
With ActiveSheet.PageSetup
.RightFooter = Sheets("gegevens").Range("d8").Value & " - " & Sheets("gegevens").Range("d24").Value
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ActiveWorkbook.Path & "\" & "Opdracht" & " " & [b14] & " " & [b11] & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
strbody = "<br>Beste relatie,<br><br>" & _
"Hierbij verstrek ik jou de werkopdracht,inclusief de plattegrond (indien voorhanden) en de planning, t.b.v. het uitvoeren van diverse werkzaamheden op het bovenstaande adres.<br>" & _
"<br>De werkopdracht is gebasseerd conform de eenheidsprijzen van ........Eventueel meerwerk uitsluitend uitvoeren i.o.m. Manus drup (06-11111111 / Manusdrup@water.nl)<br>" & _
"<br>Vertrouwende je hierbij voldoende te hebben geïnformeerd en mocht je nog vragen en/of opmerkingen hebben, dan hoor ik dat graag van je."
On Error Resume Next
With OutMail
.SentOnBehalfOfName = "hier het email adres van je andere account@live.nl"
.Display
.To = Sheets("Werkomschrijving").Range("o13")
.CC = ""
.BCC = ""
.Subject = Sheets("Werkomschrijving").Range("b14") & " " & Range("b11") & " " & "werkomschrijving" & ": " & Sheets("Werkomschrijving").Range("j13")
.HTMLBody = strbody & "<br>" & .HTMLBody
.Attachments.Add ActiveWorkbook.Path & "\" & "Opdracht" & " " & [b14] & " " & [b11] & ".pdf"
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub