Hallo,
ik dacht dat ik dit werkend kon afsluiten maar ben er nog achter gekomen dat het contract niet goed meegenomen wordt als bijlage bij Thunderbird.
Het staat er wel in maar je kan het niet openen als het klaarstaat in de mail en het wordt ook niet mee verzonden.
In Outlook gaat dit wel.
Zou iemand dit nog eens willen bekijken?
Dit was de laatste code:
Option Compare Text
Private Adres, CC, BCC, Onderwerp, Handtekening, Ondergetekende, vAttachments
__________________________________________________________________________________________________
Sub OpslaanVerzenden()
'variabelen
Plaats = "C:\JVC\Contracten\" 'AANPASSEN indien nodig (standaard: "C:\JVC\Contracten\")
Naam = Range("Q1").Value
Adres = Range("P10").Value
CC = Range("R14").Value
BCC = Range("R15").Value
Onderwerp = "Contract"
Ondergetekende = Range("P25").Value
Handtekening = "Beste," & vbLf _
& vbLf _
& vbLf _
& "Met vriendelijke groeten," & vbLf _
'Nagaan of het bestand reeds bestaat, zoniet opslaan en verder
If Dir(Plaats & Naam & ".pdf") <> "" Then
MsgBox "Het contract - " & Naam & ".pdf - bestaat reeds. Vul een ander contractnummer in of wis het bestaande contract"
Exit Sub
Else
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Plaats & Naam & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=False, IgnorePrintAreas:=False, From:=1, To:=1, OpenAfterPublish:=False
End If
'bestand toevoegen aan mail met naam vermeld in cel Q1 .... verder:
bestand = ThisWorkbook.Path & "\" & Range("Q1").Value & ".pdf" '= variabele
hhr = "C:\JVC\HHR.pdf" 'AANPASSEN indien nodig
vAttachments = Array(bestand, hhr)
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=bestand
If Range("P32").Value <> "Ja" Then 'in O32 staat er "mailen met Outlook" en in P32 via validatie kan je kiezen tussen ja en nee
Email_Thunderbird
Else
Email_Outlook
End If
Kill (bestand)
End Sub
Sub Email_Outlook()
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = Adres
.CC = CC
.BCC = BCC
.Subject = Onderwerp
.Body = Handtekening & vbNewLine & Ondergetekende
If VarType(vAttachments) > 0 Then
If IsArray(vAttachments) = False Then
.Attachments.Add vAttachments
Else
Dim sBestand As String
For Each vatt In vAttachments
sBestand = CStr(vatt)
.Attachments.Add sBestand
Next
End If
End If
.Display
End With
End Sub
[/quote]
[quote]Sub Email_Thunderbird()
thund = "C:\Program Files (x86)\Mozilla Thunderbird\thunderbird.exe " & _
"-compose " & """" & _
"to='" & Adres & "'," & _
"cc='" & CC & "'," & _
"bcc='" & BCC & "'," & _
"subject='" & Onderwerp & "'," & _
"body='" & Handtekening & vbNewLine & Ondergetekende & "'"
If VarType(vAttachments) > 0 Then
If IsArray(vAttachments) = False Then
thund = thund & ",attachment='" & vAttachments & "',"
Else
thund = thund & ",attachment='" & Join(vAttachments, ",") & "',"
End If
End If
Call Shell(thund, vbNormalFocus)
Application.Wait Now + TimeValue("00:00:02")
'SendKeys "^{ENTER}", True 'voorlopig enkel als commentaar, als je echt wil verzenden mag die enkele aanhalingsteken voorin weg
'Application.Wait Now + TimeValue("00:00:05")
End Sub