作為附件發送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
