EXCEL VBA发邮件,实现自动化批量发送

EXCEL VBA发邮件,实现自动化批量发送

python 复制代码
'以GET方式上传数据
Public Function uploadData_GET(ByVal url As String)
    Dim http
    Set http = CreateObject("Microsoft.XMLHTTP")

    http.Open "GET", url, False
    http.send
    
    Debug.Print http.getAllResponseHeaders
    Debug.Print StrConv(http.responseBody, vbUnicode)
    
    uploadData_GET = http.Status
    Set http = Nothing
End Function

'以POST方式上传数据
Public Function uploadData_POST(ByVal url As String, ByVal data As String, ByVal Content As String)
    Dim http
    Set http = CreateObject("Microsoft.XMLHTTP")
  
    http.Open "POST", url, False
    http.setRequestHeader "CONTENT-TYPE", Content
    http.send (data)
    
    Debug.Print http.getAllResponseHeaders
    Debug.Print StrConv(http.responseBody, vbUnicode)
    
    uploadData_POST = http.responseText
    Set http = Nothing
End Function


'批量发送邮件,biubiu~~
Public Function biubiu()
    
    On Error Resume Next
    Application.ScreenUpdating = False
    
    ThisWorkbook.Worksheets(1).[D1].CurrentRegion.Clear
    ThisWorkbook.Worksheets(1.[F1].CurrentRegion.Clear
    ThisWorkbook.Worksheets(1).[D1] = "已下发"
    ThisWorkbook.Worksheets(1).[F1] = "未下发"
    成功数量 = 0
    失败数量 = 0
    
    附件总数 = ThisWorkbook.Worksheets(2).[A1].CurrentRegion.Rows.Count - 1
    批次发送量 = 200
    
    For 行号 = 2 To 附件总数 + 1
        '准备下发项验证
        下发项 = ThisWorkbook.Worksheets(2).Cells(行号, 1)
        下发项验证 = 0
        下发项验证 = WorksheetFunction.CountIf(ThisWorkbook.Worksheets(1).[C:C], 下发项)
        
        biuTrue = False     '保存发送是否成功的返回值
        
        If 下发项验证 > 0 Then
            filePath = ThisWorkbook.Worksheets(2).Cells(行号, 2)
            toMail_str = formatMail(WorksheetFunction.VLookup(下发项, ThisWorkbook.Worksheets(1).[C:E], 2, 0))
            ccMail_str = formatMail(WorksheetFunction.VLookup(下发项, ThisWorkbook.Worksheets(2).[C:E], 3, 0))
            mailSubject = 下发项 & "-" & ThisWorkbook.Worksheets(1).TextBox_邮件主题.Text
            mailContent = ThisWorkbook.Worksheets(1).TextBox_邮件内容.Text
            
            mailContent = Replace(mailContent, Chr(13) & Chr(10), "<br>")
            
            biuTrue = biu(filePath, toMail_str, ccMail_str, mailSubject, mailContent)       'biu发送一封
        End If
            
相关推荐
cehuishi95279 分钟前
excel中关联word邮件合并使用
word·excel·批量打印·邮件合并
tjsoft18 分钟前
设置 windows nginx.exe 每天 重启
运维·windows·nginx
isyangli_blog24 分钟前
Windows & Linux 操作系统分区管理
linux·运维·服务器
K_i13425 分钟前
Helm 与 Ansible 深度对比解析文档
自动化·ansible
IT 小阿姨(数据库)1 小时前
PostgreSQL wal_e 工具详解
运维·数据库·sql·postgresql·centos
有想法的py工程师1 小时前
AL2系统下编译安装PSQL16.4版本
linux·运维·数据库·postgresql
努力努力再努力wz1 小时前
【C++进阶系列】:万字详解特殊类以及设计模式
java·linux·运维·开发语言·数据结构·c++·设计模式
舰长1151 小时前
nginx 负载均衡配置
运维·nginx·负载均衡
万山y3 小时前
WSL SSH 服务器一站式配置教程
运维·服务器·ssh
半梦半醒*3 小时前
Prometheus监控物理服务器
linux·运维·服务器·centos·prometheus