邮件自动发送相关人

zhenghui13

我写了一下可以将文件分割的宏,更在希望能通过OUTLOOK自动发给相关的人,不过总是不成功.
请大家帮忙看一下哪里写的有题.
Sub billsplit()
Dim cnn As Object, sql$
Dim arr, brr, m
Dim wb As Workbook
    Dim wbStr As String, nlist As String
    Dim OutlookApp
    Dim newMail
    Set OutlookApp = CreateObject("Outlook.Application")
    Dim dic, n, k, j
    Set dic = CreateObject("Scripting.Dictionary")
arr = Range("a1", [a1].End(2))
Set cnn = CreateObject("Adodb.Connection")
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;" _
            & "Data Source=" & ThisWorkbook.FullName
sql = "select distinct Cost_Center from [BILL$] where Name is not NULL"
Sheet3.[a1].CopyFromRecordset cnn.Execute(sql)
brr = cnn.Execute(sql).getrows
Application.ScreenUpdating = False
For m = 0 To UBound(brr, 2)
    Set wb = Workbooks.Add
    wb.Sheets(1).[a2].Resize(1, UBound(arr, 2)) = arr
    sql = "select * from [BILL$] where Cost_Center=" & brr(0, m) & ""
    wb.Sheets(1).[a3].CopyFromRecordset cnn.Execute(sql)
    wb.Sheets(1).Range("a2:u2") = arr
    wb.SaveAs ThisWorkbook.Path & "\" & brr(0, m) & ".xlsx"
   
            For n = 3 To [e65536].End(xlUp).Row
                dic(Range("e" & n).Value) = ""
            Next
            k = dic.keys
           wb.Sheets(1).[a1] = Replace(Join(k, ";"), " ", "")
          'nlist = [a1].Text
         
    wbStr = ActiveWorkbook.FullName
   
         Set newMail = OutlookApp.CreateItem(olMailItem)
         With newMail
            .Subject = "Airtickets"
            Set myAttachments = newMail.Attachments
                myAttachments.Add wbStr, olByValue, 1
            .To = Replace(Join(k, ";"), " ", "")
            
           ActiveWorkbook.Close
         End With
     dic.RemoveAll
  Next
Application.ScreenUpdating = True
cnn.Close: Set cnn = Nothing
End Sub


该贴已经同步到 zhenghui13的微博

artin88

如果可以不用outlook的话，可以参考下用jmail的方法。

• Function JmailSend(Subject, HtmlBody, MailTo)
  
•     Dim JmailMsg As New Jmail.Message
  
•     With JmailMsg
  
•         .Encoding = "base64"
  
•         .ContentTransferEncoding = "base64"
  
•         .MailServerUserName = "yourname" 'smtp 验证用户名
  
•         .MailServerPassWord = "yourpwd" 'smtp 验证密码
  
•         .AddRecipient MailTo '收件人
  
•         .AddRecipientCC "1177201@qq.com" '抄送
  
•         '.AddRecipientBCC "broodwar@2911.net" '暗送
  
•         .From = "artin88@163.com"
  
•         .FromName = "DD"
  
•         .Charset = "GBK"
  
•         '.ContentType = "text/plain"
  
•         '.Priority = 1  '重要级别
  
•         .Logging = True '为 True，可用 JmailMsg.Log 获得与服务器交互的详细日志信息
  
•         .Silent = True '为 True，出错时会有 JmailMsg.ErrorMessage 回送消息
  
•         .Subject = Subject
  
•         '.Body = HtmlBody    '作为纯文本内容发送，设置 Body 属性
  
•         .HtmlBody = HtmlBody '用这个可以发送 Html 内容
  
•         .Body = HtmlBody
  
•         
  
•         .AddAttachment "c:\1.jpg", False '发送附件
  
• 
  
•         If .Send("smtp.163.com") Then '指定邮件服务器
  
•             JmailSend = "发送成功"
  
•         Else
  
•             JmailSend = JmailMsg.ErrorMessage
  
•         End If
  
•         MsgBox JmailMsg.Log
  
•         .Close
  
•     End With
  
•     Set JmailMsg = Nothing
  
• End Function
  
• 
  
• Sub mail163()
  
•     JmailSend "test", "teeeest body", "1177201@qq.com"
  
• End Sub
  
  

zhenghui13

谢谢关注，公司电脑，只能用OUTLOOK