標題: 用Excel整批寄電子郵件(Email) [打印本頁]

---

作者: 198188    時間: 2012-11-9 22:58     標題: 用Excel整批寄電子郵件(Email)

Private Sub cmdSendMail_Click()
    Dim objCdo As Object
   
    'Dim objCdo As CDO.Message
        
    strCfg = "http://schemas.microsoft.com/cdo/configuration/"

    'Set objCdo = New CDO.Message
    Set objCdo = CreateObject("CDO.Message")
   
    i = 2
   
    With objCdo
    .From = Sheet1.Range("from")
    .Fields("urn:schemas:mailheader:X-Priority") = 1 ' Priority = PriorityUrgent 高優先順序
    .Configuration(strCfg & "sendusing") = 2 ' Sendusing = SendUsingPort
    .Configuration(strCfg & "smtpserver") = Sheet1.Range("smtp") ' SMTP Server
    .BodyPart.Charset = "utf-8"   '使用編碼方式

    End With
   
    If Sheet1.Range("username") <> "" Then
     ' SMTP Server 如需登錄 , 則需設定 UserName / Password
       objCdo.Configuration(strCfg & "sendusername") = Sheet1.Range("username")
       objCdo.Configuration(strCfg & "sendpassword") = Sheet1.Range("password")
    End If
   
    objCdo.Configuration.Fields.Update ' 更新 (欄位) 組態
   
    While Sheet2.Range("A" & i) <> ""
        
        objCdo.To = Sheet2.Range("A" & i)
        
        objCdo.CC = Sheet2.Range("B" & i)
   
        objCdo.BCC = Sheet2.Range("c" & i)
        
        objCdo.Subject = Sheet2.Range("d" & i)
        
        If Sheet2.Range("A" & i) = "([email protected])" Then
           MsgBox
           Exit Sub
        End If

---

作者: vinejason    時間: 2016-4-21 14:26

回復 1# 198188

前輩平安
很有趣的技巧
這個技巧如何使用 ?

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)