作为附件发送Sub 全自动发送邮件()Dim myOlApp As ObjectDim myitem As ObjectDim i As Integer, j As Integer, icol As Integer, k As IntegerDim strg As StringDim atts As ObjectDim mycc As ObjectDim myfile As StringSet myOlApp = CreateObject("Outlook.Application")'设置对Sheet1工作表进行操作，可自行修改With Sheets("Sheet1")i = 2 '第一行为标题行，从第二行开始Do While .Cells(i, 2) <> "" '本例中判断当某行第二列为空时，停止发送邮件'设置调用Outlook来发送邮件Set myitem = myOlApp.CreateItem(0)Set atts = myitem.Attachmentsmyitem.To = .Cells(i, 3) '收件人邮箱地址调用了第3列邮箱的数据myitem.Subject = .Cells(i, 1) '标题调用了第1列的数据myitem.Body = .Cells(i, 11)icol = Cells(i, 50).End(xlToLeft).ColumnFor k = 4 To icolmyfile = Dir(ThisWorkbook.Path & "\" & .Cells(i, k)) '在本工作薄的根目录下找出附件，且附件的文件名是第四列数据If myfile <> "" Then myitem.Attachments.Add ThisWorkbook.Path & "\" & myfile, 1Next'预览，如果想直接发送，把.display改为.send'myitem.sendmyitem.displayi = i + 1strg = ""LoopEnd WithSet myitem = NothingEnd Sub
