"Dé grootste en gratis computerhelpdesk van Nederland"
Leesbevestiging
- Onderwerp starter basblok
- Startdatum
- Status
.Dit is de code die er in staat.
Option Explicit
Public PDF As String
Sub CDOmail(Blad As String, msgOnderwerp As String, Tekst As Range)
Dim iMsg As Object
Dim iConf As Object
Dim objImage As Object
Dim Flds As Variant
Dim Schema As String
Dim msgTekst As String
Dim SMTPsendusing As Integer
Dim SMTPauthenticate As Integer
Dim SMTPserver As String
Dim SMTPserverport As Integer
Dim SMTPusessl As Boolean
Dim SMTPusername As String
Dim SMTPpassword As String
Dim SMTPconnectiontimeout As Integer
ThisWorkbook.Activate
SMTPsendusing = Range("SMTPtype")
SMTPauthenticate = Range("SMTPauthenticate")
SMTPserver = Range("SMTPserver")
SMTPserverport = Range("SMTPport")
SMTPusessl = Range("SMTPusessl")
SMTPusername = Range("SMTPusername")
SMTPpassword = Range("SMTPpassword")
SMTPconnectiontimeout = Range("SMTPtimeout")
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Schema = "http://schemas.microsoft.com/cdo/configuration/"
iConf.Load -1 'zet CDO standaard instellingen
Set Flds = iConf.Fields
With Flds
.Item(Schema & "sendusing") = SMTPsendusing
.Item(Schema & "smtpauthenticate") = SMTPauthenticate
.Item(Schema & "smtpserver") = SMTPserver
.Item(Schema & "smtpserverport") = SMTPserverport 'Niet gebruiken bij Office365 SMTP
.Item(Schema & "smtpusessl") = SMTPusessl
.Item(Schema & "sendusername") = SMTPusername
.Item(Schema & "sendpassword") = SMTPpassword
.Item(Schema & "smtpconnectiontimeout") = SMTPconnectiontimeout
.Update
End With
msgTekst = RangeToHTML(Tekst)
With iMsg
.AutoGenerateTextBody = False
Set .Configuration = iConf
.To = HW.Sheets(Blad).Range("E13")
.CC = ""
.BCC = "nel_twigt@yahoo.com"
.From = SMTPusername
.Subject = msgOnderwerp
.HTMLBody = "<html><img src=""cid:LogoDistrict.gif""></html>" & msgTekst
Set objImage = iMsg.AddRelatedBodyPart(ThisWorkbook.Path & "\LogoDistrict.gif", "LogoDistrict.gif", 1)
objImage.Fields.Item("urn:schemas:mailheader:Content-ID") = "<LogoDistrict.gif>"
objImage.Fields.Update
.AddRelatedBodyPart ThisWorkbook.Path & "\LogoDistrict.gif", "LogoDistrict.gif", 1
.AddAttachment PDF
.Send
End With
If Err.Number <> 0 Then
MsgBox ActiveSheet.Name & vbCrLf & _
Err.Number & " - " & Err.Description, vbCritical, "Faktuur verzenden mislukt"
Else
MsgBox "De factuur is succesvol als PDF verzonden ! ", vbExclamation, "Bas Blok"
End If
Set iMsg = Nothing
Set iConf = Nothing
Set Flds = Nothing
End Sub
Option Explicit
Public PDF As String
Sub CDOmail(Blad As String, msgOnderwerp As String, Tekst As Range)
Dim iMsg As Object
Dim iConf As Object
Dim objImage As Object
Dim Flds As Variant
Dim Schema As String
Dim msgTekst As String
Dim SMTPsendusing As Integer
Dim SMTPauthenticate As Integer
Dim SMTPserver As String
Dim SMTPserverport As Integer
Dim SMTPusessl As Boolean
Dim SMTPusername As String
Dim SMTPpassword As String
Dim SMTPconnectiontimeout As Integer
ThisWorkbook.Activate
SMTPsendusing = Range("SMTPtype")
SMTPauthenticate = Range("SMTPauthenticate")
SMTPserver = Range("SMTPserver")
SMTPserverport = Range("SMTPport")
SMTPusessl = Range("SMTPusessl")
SMTPusername = Range("SMTPusername")
SMTPpassword = Range("SMTPpassword")
SMTPconnectiontimeout = Range("SMTPtimeout")
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Schema = "http://schemas.microsoft.com/cdo/configuration/"
iConf.Load -1 'zet CDO standaard instellingen
Set Flds = iConf.Fields
With Flds
.Item(Schema & "sendusing") = SMTPsendusing
.Item(Schema & "smtpauthenticate") = SMTPauthenticate
.Item(Schema & "smtpserver") = SMTPserver
.Item(Schema & "smtpserverport") = SMTPserverport 'Niet gebruiken bij Office365 SMTP
.Item(Schema & "smtpusessl") = SMTPusessl
.Item(Schema & "sendusername") = SMTPusername
.Item(Schema & "sendpassword") = SMTPpassword
.Item(Schema & "smtpconnectiontimeout") = SMTPconnectiontimeout
.Update
End With
msgTekst = RangeToHTML(Tekst)
With iMsg
.AutoGenerateTextBody = False
Set .Configuration = iConf
.To = HW.Sheets(Blad).Range("E13")
.CC = ""
.BCC = "nel_twigt@yahoo.com"
.From = SMTPusername
.Subject = msgOnderwerp
.HTMLBody = "<html><img src=""cid:LogoDistrict.gif""></html>" & msgTekst
Set objImage = iMsg.AddRelatedBodyPart(ThisWorkbook.Path & "\LogoDistrict.gif", "LogoDistrict.gif", 1)
objImage.Fields.Item("urn:schemas:mailheader:Content-ID") = "<LogoDistrict.gif>"
objImage.Fields.Update
.AddRelatedBodyPart ThisWorkbook.Path & "\LogoDistrict.gif", "LogoDistrict.gif", 1
.AddAttachment PDF
.Send
End With
If Err.Number <> 0 Then
MsgBox ActiveSheet.Name & vbCrLf & _
Err.Number & " - " & Err.Description, vbCritical, "Faktuur verzenden mislukt"
Else
MsgBox "De factuur is succesvol als PDF verzonden ! ", vbExclamation, "Bas Blok"
End If
Set iMsg = Nothing
Set iConf = Nothing
Set Flds = Nothing
End Sub
Aar
Inventaris
- Lid geworden
- 3 aug 2014
- Berichten
- 10.138
- Besturingssysteem
- Windows 11 en diverse Linux-soorten
- Office versie
- Office 365
Leesbevestiging is gelukkig niet verplicht in mails.
Zou anders een mooie aanwinst voor spammers zijn.
Zorg liever dat je een goede SMTP-server gebruikt van een partij die mailen in hoog vaandel heeft staan.
Zou anders een mooie aanwinst voor spammers zijn.
Zorg liever dat je een goede SMTP-server gebruikt van een partij die mailen in hoog vaandel heeft staan.
Verzenden factuur
Geacht forum,
Het versturen van de facturen gaat niet goed en werkt dus ook niet.
De ontvangers krijgen de factuur niet.
Ook kan ik niet zien of die factuur werkelijk op het adres is afgeleverd.
Is dat op een of andere manier te herstellen?
Zie met belangstelling een oplossing tegemoet.
Bij voorbaat dank voor de hulp.
Geacht forum,
Het versturen van de facturen gaat niet goed en werkt dus ook niet.
De ontvangers krijgen de factuur niet.
Ook kan ik niet zien of die factuur werkelijk op het adres is afgeleverd.
Is dat op een of andere manier te herstellen?
Zie met belangstelling een oplossing tegemoet.
Bij voorbaat dank voor de hulp.
Bijlagen
cow18
Terugkerende gebruiker
- Lid geworden
- 24 mei 2008
- Berichten
- 4.276
- Besturingssysteem
- Windows
- Office versie
- Excel365
van deze kant krijg ik ook dat de mail verzonden is, maar die komt bij mij ook niet aan.
Heb verder geen ervaring met CDOMail, dus het kan zijn dat er bepaalde individuele instellingen niet correct zijn.
Heb je geen ander mailprogramma dat je kan gebruiken (outlook, thunderbird, ...) ?
Aanpassing, ik had 2 mails verstuurd en die zijn later (10 minuten) aangekomen, toen had ik de computer al uit gezet.
Misschien voor de veiligheid de penningmeester van knbbmiddenholland verwittigen dat die 2 mails van vannacht fake zijn.
Heb verder geen ervaring met CDOMail, dus het kan zijn dat er bepaalde individuele instellingen niet correct zijn.
Heb je geen ander mailprogramma dat je kan gebruiken (outlook, thunderbird, ...) ?
Aanpassing, ik had 2 mails verstuurd en die zijn later (10 minuten) aangekomen, toen had ik de computer al uit gezet.
Misschien voor de veiligheid de penningmeester van knbbmiddenholland verwittigen dat die 2 mails van vannacht fake zijn.
Laatst bewerkt:
- Status
