'以GET方式上传数据
Public Function uploadData_GET( ByVal url As String) Dim httpSet http = CreateObject( "Microsoft.XMLHTTP" ) http. Open "GET" , url, False http. 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, False http. 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 = False ThisWorkbook. 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 批次发送量 = 200 For 行号 = 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
)
