Excel VBA 如何自动发送邮件（Foxmail）

zhoucs00

我想实现的功能是：
Excel 自动发送邮件，现在的代码可以实现弹出如下的界面，但还需要自己手动点击发送，要是有很多次的话，手动点击就比较麻烦。
所以我想Excel是否可控制Foxmail发送的快捷键（Ctrl+Enter），只接发送，不需要弹出如下的对话框。

1. Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
   
2. Sub 多人批量发邮件() '一次发给多人邮件 【Ctrl+Enter Foxmail 发送邮件快捷键】
   
3. Dim rng As Range, MyMail As String, str As String, Temp As String, i As Integer
   
4. For Each rng In Range([c2], Cells(Rows.Count, 3).End(xlUp)) '遍历C列所有非空单元格(标题除外)
   
5. str = str & rng.Text & ";" '串连所有数据,以";"分隔
   
6. Next
   
7. For Each rng In Range([A2], Cells(Rows.Count, 2).End(xlUp)) ''遍历B列所有非空单元格(标题除外)
   
8. i = i + 1 '累加变量
   
9. Temp = Temp & rng.Text & IIf(i Mod 2, " ", "%0A") '串连所有数据,用空格或者换行符"%0A"分隔
   
10. Next
    
11. MyMail = "mailto:" & Mid$(str, 1, Len(str) - 1) & "?subject=成绩通知&body=成绩表：%0A" & Temp & "%0A%0A" + Space(20) & "通知日期：" & Date
    
12. ShellExecute 0&, vbNullString, MyMail, vbNullString, vbNullString, 1 '发邮件
    
13. Application.SendKeys "^~"
    
14. End Sub
    

复制代码

如上代码，我加了个 Application.SendKeys "^~" 不能够控制Foxmail发送邮件，麻烦大家看一下，谢谢。


Excel 分批发邮件.rar (15.46 KB, 下载次数: 635)

2013-12-30 10:55 上传

点击文件名下载附件

该贴已经同步到 zhoucs00的微博

闻启学

我找了一下资料  希望对楼主有帮助 我Foxmail 无安装  只是玩 outlook

1. 
   
2. '       邮件地址
   
3.         Email = "xxxx@xxx.com"
   
4.         CC = "xxxx@xxx.com"
   
5.         
   
6. '       主题
   
7.         Subj = "xxxxxx" & Date
   
8. '       邮件内容
   
9.         'Msg = ""
   
10.         'Msg = Msg & "XXX你好：" & vbCrLf & vbCrLf
    
11.         txtAttachment = ThisWorkbook.Path & "" & "xxxx" & Date & ".xls"
    
12.         
    
13. '       Replace spaces with %20 (hex)
    
14.         Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
    
15.         Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")
    
16.                
    
17. '       Replace carriage returns with %0D%0A (hex)
    
18.         Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")
    
19.         
    
20. '       Create the URL
    
21.         URL = "mailto:" & Email & "?CC=" & CC & "&subject=" & Subj & "&body=" & Msg & "&Attach=" & Chr$(34) & txtAttachment & Chr$(34)
    
22. 
    
23. '       Execute the URL (start the email client)
    
24.         ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus

复制代码

zhoucs00

闻启学 发表于 2013-12-30 11:16
我找了一下资料  希望对楼主有帮助 我Foxmail 无安装  只是玩 outlook

嗯，先谢谢了，公司电脑是Foxmail的木有办法，嘿嘿。

研究研究

闻启学 发表于 2013-12-30 11:16
我找了一下资料  希望对楼主有帮助 我Foxmail 无安装  只是玩 outlook

你好，我在http://club.excelhome.net/forum. ... amp;fromuid=1900253 看到您的文件，我不知为什么完全使用您的代码测试就是无法加上附件（我用的Foxmail是7.2版的）望解答

lusa

WO TEBIEXUYAO

有趣的肉体

这个问题解决了吗，我也是卡在这一步

有趣的肉体

因为系统调用FOXMAIL需要时间，所以需要在Application.SendKeys "^~"前面加一句Application.Wait Now + TimeValue("00:00:05"),就可以了。

tdpzby

foxmail=QQ mail