Sub CDO_Mail_Workbook()
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim iMsg As Object
Dim iConf As Object
Dim Flds As Variant
Set wb = ActiveWorkbook
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
TempFilePath = Environ$("temp") & "\"
TempFileName = "Copy of " & wb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
FileExtStr = "." & LCase(Right(wb.Name, Len(wb.Name) - InStrRev(wb.Name, ".", , 1)))
wb.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = [COLOR="#FF0000"]465 'niet poort 25 maar poort 465
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True 'toegevoegd versleutelde aanmelding
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60 'toegevoegd timeout
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 'toegevoegd aanmelden
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "username" 'toegevoegd username
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password" 'toegevoegd password
[/COLOR].Update
End With
With iMsg
Set .Configuration = iConf
.To = "jaap_zonneveld@quicknet.nl"
.CC = ""
.BCC = ""
.From = """Jaap"" <jaap.zonneveld9@gmail.com>"
.Subject = "Test verzenden kasblad"
.TextBody = "Groetjes Jaap"
.AddAttachment TempFilePath & TempFileName & FileExtStr
.Send
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
