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
            
相关推荐
知白守黑2674 分钟前
Ansible角色
运维·服务器·ansible
Jwest20214 分钟前
工业显示器在地铁电力监控与运维中的应用
运维·计算机外设
明达智控技术5 小时前
MR30分布式I/O模块在化工行业的应用
物联网·自动化
双翌视觉5 小时前
机器视觉的手机柔性屏贴合应用
智能手机·自动化·视觉检测·机器视觉
Mr. Cao code6 小时前
Docker:颠覆传统虚拟化的轻量级革命
linux·运维·ubuntu·docker·容器
wanhengidc7 小时前
云手机运行流畅,秒开不卡顿
运维·网络·科技·游戏·智能手机
笨小孩@GF 知行合一8 小时前
OSPF实验:外部路由引入
运维·网络·hcip·数通·ospf
asdfg12589638 小时前
为什么要在出口路由器router配置NAT与默认路由
运维·网络·计算机网络
bug攻城狮9 小时前
Skopeo 工具介绍与 CentOS 7 安装指南
linux·运维·centos
宇宙第一小趴菜9 小时前
08 修改自己的Centos的软件源
linux·运维·centos