[µo°Ý] µ{¦¡­×§ï

yuras

¤S¨Ó½Ð°Ý¦U¦ì°ª¤â ¡A¤@­×§ïVB³£µo¥Í¿ù»~  :Q    ÁÂÁÂ
(1) username¡Bpassword ¦p¦ó­×¦¨¤£«ü©wÄæ¦ì­È¡A¥iª½±µ¦bVB¤W
(2)  strTextBody¤º®e ¥i¥H«ü©w SHEETÄæ¦ì½d³ò  EX:¤U­±¹Ï¤ù  

¤U¸ü (25.1 KB)
SHEET-©ú²Ó

2012-1-5 22:28

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 °ªÀu¥ý¶¶§Ç
    .Configuration(strCfg & "sendusing") = 2 ' Sendusing = SendUsingPort
    .Configuration(strCfg & "smtpserver") = Sheet1.Range("smtp") ' SMTP Server
    End With
   
    If Sheet1.Range("username") <> "" Then
     ' SMTP Server ¦p»Ýµn¿ý , «h»Ý³]©w UserName / Password
      objCdo.Configuration(strCfg & "sendusername") = Sheet1.Range("username")
       objCdo.Configuration(strCfg & "sendpassword") = Sheet1.Range("password")
    End If
   
    objCdo.Configuration.Fields.Update ' §ó·s (Äæ¦ì) ²ÕºA
   
    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    '§R°£«e¤@«Êªºªþ¥ó
        
        While Sheet2.Cells(i, j) <> ""
            objCdo.AddAttachment Sheet2.Cells(i, j)
            j = j + 1
        Wend
        
        
        
        objCdo.Send '±Nemail±H¥X
        
        Sheet2.Range("k" & i) = "±H¥X"
        i = i + 1
    Wend

   
    Set iMsg = Nothing
    Set iConf = Nothing
   
End Sub