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
            
相关推荐
de之梦-御风7 小时前
【Linux】 开启关闭MediaMTX服务
linux·运维·服务器
IT 小阿姨(数据库)8 小时前
PostgreSQL通过pg_basebackup物理备份搭建流复制备库(Streaming Replication Standby)
运维·服务器·数据库·sql·postgresql·centos
旗讯数字9 小时前
企业OCR实战:基于OCR技术实现双节差旅报销单表格解析与文字信息自动化采集
运维·自动化·ocr·表格识别
bst@微胖子9 小时前
Harmony中EventHub实现发布订阅
linux·运维·ubuntu
毕业设计论文10 小时前
个人备忘录的设计与实现
运维·服务器·网络
Justin_1911 小时前
nginx反向代理与缓存功能
运维·nginx
尹蓝锐11 小时前
在学校Linux服务器上配置go语言环境
linux·运维·服务器
XUE-521131412 小时前
组播实验-IGMP、IGMP Snooping及PIM-DM协议
运维·网络·网络协议·智能路由器
小伟55312 小时前
Keepalived 高可用实战(Ubuntu 24.04)
运维
运维闲章印时光13 小时前
网络断网、环路、IP 冲突?VRRP+MSTP+DHCP 联动方案一次性解决
运维·服务器·开发语言·网络·php