win7旗舰版下：VBA代码无法发送QQ邮件（附件），折腾我几天未决，大侠救我

wmqz.130

weiyingde 发表于 2018-3-3 22:30
我已经找到了新安装的位置"c:\\programfile\dimac\w3jmail"。并且重新添加了引用，很可惜仍旧没有成功。
...

这是我笔记本电脑引用图，我装完我发的那个组件，并没有特意在引用里选取引用，只是装完组件，就可以发送了。

因为代码是  Set JmailMsg = CreateObject("JMail.Message")  用代码创建了，因此不用引用，也是可以的。

weiyingde

仍然在关注，望大侠出来给予指点。翘首以待……

kangatang

发个邮件有这么难吗。

weiyingde

kangatang 发表于 2018-3-12 23:32
发个邮件有这么难吗。

不是难不难的问题，而是想就此拓展一下，积累多种发邮件的方法，也是为了工作中能够

用得顺手。
情况是目前有两种已经设计并测试成功：
第一种：用CDO.dll，通过自己的QQ邮箱群发信息和附件给多个QQ邮箱；
第二种：用jmail.dll，通过自己的163.com邮箱群发发信息和附件给多个QQ邮箱；
目前的问题和尝试目标是：
用jmail.dll，通过自己的QQ邮箱群发信息和附件给多个QQ邮箱。
而我的尝试没有成功，见http://club.excelhome.net/thread-1397706-12-1.html
第120楼，你若有心帮助，借用一下功夫，帮我看看。
先谢了。

weiyingde

再次求教于大方之家，谢谢。

lovingchina

win10 64位操作系统+ excel 64位 用，楼主说的【生成码】 给QQ，163邮箱成功了

weiyingde

lovingchina 发表于 2018-10-11 19:10
win10 64位操作系统+ excel 64位 用，楼主说的【生成码】 给QQ，163邮箱成功了

谢谢你，64位的，对电脑硬件有要求吗？
我的邮箱是hgyswyd@163.com
谢谢的热心援助。
谢谢

kings12333

weiyingde 发表于 2018-10-12 11:47
谢谢你，64位的，对电脑硬件有要求吗？
我的邮箱是
谢谢的热心援助。

163的SMTP端口邮件发多了，会经常封的，建议使用139的邮箱，测试爽歪歪

182197315

Sub SendEmail()
  'Uses early binding
  'Requires a reference to the Outlook Object Library
  Dim OutlookApp As Outlook.Application
  Dim MItem As Outlook.MailItem
  Dim cell As Range
  Dim Subj As String
  Dim EmailAddr As String
  Dim Recipient As String
  Dim Bonus As String
  Dim Msg As String
  
  'Create Outlook object
  Set OutlookApp = New Outlook.Application
  
  'Loop through the rows
  For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
    If cell.Value Like "*@*" Then
      'Get the data
      Subj = "Your Annual Bonus"
      Recipient = cell.Offset(0, -1).Value
      EmailAddr = cell.Value
      Bonus = Format(cell.Offset(0, 1).Value, "$0,000.")
            
     'Compose message
      Msg = "Dear " & Recipient & vbCrLf & vbCrLf
      Msg = Msg & "I am pleased to inform you that your annual bonus is "
      Msg = Msg & Bonus & vbCrLf & vbCrLf
      Msg = Msg & "William Rose" & vbCrLf
      Msg = Msg & "President"
   
      'Create Mail Item and send it
      Set MItem = OutlookApp.CreateItem(olMailItem)
      With MItem
        .To = EmailAddr
        .Subject = Subj
        .Body = Msg
        .Send
      End With
    End If
  Next
End Sub

ndt3

楼主cdo方法测试过了，怎么操作的，我始终不能运行。
代码如下：
Sub CDOSENDEMAIL3()

Dim CDOMail As Variant

On Error Resume Next '出错后继续执行

Application.DisplayAlerts = False '禁用系统提示

ThisWorkbook.ChangeFileAccess Mode:=xlReadOnly '将工作簿设置为只读模式

Set CDOMail = CreateObject("CDO.Message") '创建对象

CDOMail.From = "12345678@163.com" '设置发信人的邮箱

CDOMail.To = "12345678@qq.com" '设置收信人的邮箱

CDOMail.Subject = "主题:用CDO发送邮件试验" '设定邮件的主题

'CDOMail.TextBody = "文本内容" '使用文本格式发送邮件

CDOMail.HtmlBody = "当您看到此封邮件，表明CDO设置正确" '使用Html格式发送邮件

CDOMail.AddAttachment ThisWorkbook.FullName '发送本工作簿为附件

STUl = "http://schemas.microsoft.com/cdo/configuration/" '微软服务器网址

With CDOMail.Configuration.Fields

.Item(STUl & "smtpserver") = "smtp.163.com" 'SMTP服务器地址

.Item(STUl & "smtpserverport") = 994 'SMTP服务器端口,465也试过不行

.Item(STUl & "sendusing") = 2 '发送端口

.Item(STUl & "smtpauthenticate") = 1 '远程服务器需要验证

.Item(STUl & "sendusername") = "AAAAAA" '发送方邮箱名称

.Item(STUl & "sendpassword") = "AAAAAA" '发送方邮箱密码

.Item(STUl & "smtpconnectiontimeout") = 120 '连接超时（秒）

.Update

End With

CDOMail.Send '执行发送

Set CDOMail = Nothing '发送成功后即时释放对象

If Err.Number = 0 Then

MsgBox "成功发送邮件", , "温馨提示" '如果没有出错，则提示发送成功

Else

MsgBox Err.Description, vbInformation, "邮件发送失败" '如果出错，则提示错误类型和错误代码

End If

ThisWorkbook.ChangeFileAccess Mode:=xlReadWrite '将工作簿设置为读写模式

Application.DisplayAlerts = True '恢复系统提示

End Sub