EXCEL VBA發郵件，實現自動化批量發送

'以GET方式上傳數據
Public Function uploadData_GET(ByVal url As String)Dim httpSet http = CreateObject("Microsoft.XMLHTTP")http.Open "GET", url, Falsehttp.sendDebug.Print http.getAllResponseHeadersDebug.Print StrConv(http.responseBody, vbUnicode)uploadData_GET = http.StatusSet http = Nothing
End Function'以POST方式上傳數據
Public Function uploadData_POST(ByVal url As String, ByVal data As String, ByVal Content As String)Dim httpSet http = CreateObject("Microsoft.XMLHTTP")http.Open "POST", url, Falsehttp.setRequestHeader "CONTENT-TYPE", Contenthttp.send (data)Debug.Print http.getAllResponseHeadersDebug.Print StrConv(http.responseBody, vbUnicode)uploadData_POST = http.responseTextSet http = Nothing
End Function'批量發送郵件，biubiu~~
Public Function biubiu()On Error Resume NextApplication.ScreenUpdating = FalseThisWorkbook.Worksheets(1).[D1].CurrentRegion.ClearThisWorkbook.Worksheets(1.[F1].CurrentRegion.ClearThisWorkbook.Worksheets(1).[D1] = "已下發"ThisWorkbook.Worksheets(1).[F1] = "未下發"成功數量 = 0失敗數量 = 0附件總數 = ThisWorkbook.Worksheets(2).[A1].CurrentRegion.Rows.Count - 1批次發送量 = 200For 行號 = 2 To 附件總數 + 1'準備下發項驗證下發項 = ThisWorkbook.Worksheets(2).Cells(行號, 1)下發項驗證 = 0下發項驗證 = WorksheetFunction.CountIf(ThisWorkbook.Worksheets(1).[C:C], 下發項)biuTrue = False     '保存發送是否成功的返回值If 下發項驗證 > 0 ThenfilePath = 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_郵件主題.TextmailContent = ThisWorkbook.Worksheets(1).TextBox_郵件內容.TextmailContent = Replace(mailContent, Chr(13) & Chr(10), "<br>")biuTrue = biu(filePath, toMail_str, ccMail_str, mailSubject, mailContent)       'biu發送一封End If