標題: [發問] 程式修改 [打印本頁]

---

作者: yuras    時間: 2012-1-5 22:29     標題: 程式修改

又來請問各位高手 ，一修改VB都發生錯誤  :Q    謝謝
(1) username、password 如何修成不指定欄位值，可直接在VB上
(2)  strTextBody內容 可以指定 SHEET欄位範圍  EX:下面圖片  
[attach]9090[/attach]

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
    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)
        
       strTextBody = Sheet2.Range("e" & i)
        If Sheet1.Range("type") = "txt" Then
            objCdo.TextBody = strTextBody
        Else
            objCdo.HTMLBody = strTextBody
        End If
        
        j = 6
        
        objCdo.Attachments.DeleteAll    '刪除前一封的附件
        
        While Sheet2.Cells(i, j) <> ""
            objCdo.AddAttachment Sheet2.Cells(i, j)
            j = j + 1
        Wend
        
        
        
        objCdo.Send '將email寄出
        
        Sheet2.Range("k" & i) = "寄出"
        i = i + 1
    Wend

   
    Set iMsg = Nothing
    Set iConf = Nothing
   
End Sub

---

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