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
            
相关推荐
小白爱电脑37 分钟前
什么是2.5G交换机?
运维·网络·5g·千兆宽带
?ccc?37 分钟前
容器技术技术入门与 Docker 环境部署
运维·docker·容器
时时刻刻看着自己的心1 小时前
docker启动报错
运维·docker·容器
我科绝伦(Huanhuan Zhou)1 小时前
华为泰山服务器重启后出现 XFS 文件系统磁盘“不识别”(无法挂载或访问),但挂载点目录仍在且无数据
运维·服务器·华为
匆匆那年9672 小时前
Docker容器中安装MongoDB,导入数据
运维·docker·容器
望获linux2 小时前
【Linux基础知识系列】第四十三篇 - 基础正则表达式与 grep/sed
linux·运维·服务器·开发语言·前端·操作系统·嵌入式软件
万米商云2 小时前
企业物资集采平台解决方案:跨地域、多仓库、百部门——大型企业如何用一套系统管好百万级物资?
大数据·运维·人工智能
挑战者6668883 小时前
CentOS 系统高效部署 Dify 全攻略
linux·运维·centos
网硕互联的小客服4 小时前
服务器经常出现蓝屏是什么原因导致的?如何排查和修复?
运维·服务器·stm32·单片机·网络安全
喜欢吃豆5 小时前
从零构建MCP服务器:FastMCP实战指南
运维·服务器·人工智能·python·大模型·mcp