ببخشید اشتباه شد به صورت ضمیمه در outlook برای ایمیل
کد:
Sub EMAILLIST()
Dim cell As Object
Dim NR As Long
Dim tagerror As String
Dim Email_Send_To, Email_Send_From, Email_Subject, Email_Body As String
Dim strUserEmail As String
Dim strFirstClassPassword As String
Dim errPar As String
Dim iMsg As Object
Dim iConfig As Object
Dim sConfig As Variant
Dim Row As Integer
Dim Atc As String
Set xBook = activeworkbook
Set iSh = xBook.Sheets("INPUT")
strUserEmail = xBook.Sheets("INPUT").Range("MMAIL")
strFirstClassPassword = ""
Set iMsg = CreateObject("CDO.Message")
Set iConfig = CreateObject("CDO.Configuration")
iConfig.Load -1
Set sConfig = iConfig.Fields
With sConfig
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "192.168.0.5" 'Name or IP of remote SMTP server
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 'Server Port
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = strUserEmail
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strFirstClassPassword
.Update
End With
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
|
اخطار: این یک موضوع قدیمی است به دلیل قدیمی بودن موضوع، ممکن است برخی فایل های ضمیمه به درستی کار نکنند. لطفا در صورت عدم ضرورت، از بالا آوردن موضوعات قدیمی خودداری نمایید. |
|
علاقه مندی ها (Bookmarks)