VBA CDO在电子邮件正文中发送旧图像

时间:2017-05-02 16:35:28

标签: vba excel-vba cdo.message excel

我使用vba使用CDO发送电子邮件(见下文),它会在30天前从发送的电子邮件中提取旧图像。有人可以帮忙吗?

Public Function sndmail(ByVal RecipientList As String, _
    ByVal Subject As String, ByVal body As String, Optional ByVal Attachment As String, _
    Optional ByVal cc As String)
Dim iMsg As Message
Dim iConf As Configuration
Dim strbody As String
Dim Flds As Variant

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

iConf.Load -1    ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
  .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
  .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "SMTP.xx.xyz.COM"
  .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
  .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
  .Update
End With

With iMsg
    Set .Configuration = iConf
    .To = RecipientList
    .cc = cc
    .From = "chris@yoohoo.com"
    .Subject = Subject
    .HTMLBody = body
End With

iMsg.Send

End Function

...

imgfile = "C:\TEMP\FDW_Img.png"
imgfile2 = "C:\TEMP\FDW_DoD.png"
Set pp = New PowerPoint.Application
Set ppt = pp.Presentations.Open("C:\TEMP\bpp.pptx")
wbk1.Sheets("Summary by Modcode").Range("F22:Z28").Copy
ppt.Slides(1).Shapes.PasteSpecial (ppPasteBitmap)
ppt.Slides(1).Shapes(1).Export imgfile, ppShapeFormatPNG
ppt.Close
pp.Quit
DoEvents

'list of recipients
sndto = ""
'subject line for email
subj = "5 State Capital Finance Reports for  " & Date
'body of email
bod = "Happy " & WeekdayName(Weekday(Date)) & "! <br>" & WeekdayName(Weekday(Date)) & "'s reports have been updated and can be found at the below links and snapshots can be found at the first weblink:<br><br>" & _
 "<a href = a weblink here that currently works fine> Finance Website </a> <br>" & _
    "<a href = another one here... works fine> Open vs Actuals </a> <br>" & _
    "<a href = another one here... works fine> EE Report <a><br>" & _
    "<a href = another one here... works fine> FDW Actuals <a>" & _
    " <br> <br><img src='C:\Temp\FDW_img.png'><br><br>" & sig
'function to send email
sndmail sndto, subj, bod
Application.CutCopyMode = False
wbk1.Close False

此行是将图像添加到电子邮件正文的位置,它正在添加旧图像......奇怪的是,如果我拉出我的电子邮件,它在主机上显示正确但在所有其他收件人上或者如果我在另一台电脑上拔出我的电子邮件,它会显示旧图像。

" <br> <br><img src='C:\Temp\FDW_img.png'><br><br>" & sig

0 个答案:

没有答案