ईमेल भेजने वाले VBA Outlook ईमेल भेजने वाले VBA Outlook एक ईमेल प्रोग्राम है जो Microsoft Outlook के साथ संप्रेषण के द्वारा ईमेल भेजता है.
व्याख्या ईमेल भेजने वाले VBA Outlook एक एक्सेल VBA प्रोग्राम है जो Microsoft Outlook के साथ संचार. कार्यक्रम ईमेल भेजता है तुम पर एक पूर्वनिर्धारित स्थान से कंप्यूटर टेम्पलेट्स, फाइल करने के लिए एक हो बहुधा फाइल की जरूरत है.. वहाँ भी कुछ ईमेल पतों को रोकने के लिए एक समारोह है. कार्यक्रम की आवश्यकता संदर्भ "Microsoft Outlook XX.X Object पुस्तकालय" सक्षम होने के लिए.
पूरे एक्सेल VBA प्रोग्राम इस पृष्ठ के नीचे, पर डाउनलोड करने का आनंद के लिए उपलब्ध है!
कोड Sub Email_Sender_VBA_Microsoft_Outlook()
Dim NoMailList(1500)
Call LoadNoMailList(NoMailList)
WaitTimeSecondsBetweenMail = Range("c4").Value
PlaceToStoreEmailTemplate = Range("c5").Value
RowA = 0
While Range("A14").Offset(RowA, 0).Value <> tom
ToAdress = Range("c14").Offset(RowA, 0).Value
Subject = Range("d14").Offset(RowA, 0).Value
FileName = Range("D14").Offset(RowA, 0).Value
Call WaitTimeProgram(WaitTimeSecondsBetweenMail)
Subject = Range("e14").Offset(RowA, 0).Value
Call MatchAdressWithNoMailList(ToAdress, Funnen, NoMailList)
If Funnen = False Then
Call EmailSenderProgram(ToAdress, FileName, Subject, PlaceToStoreEmailTemplate)
End If
RowA = RowA + 1
Wend
End Sub
Sub EmailSenderProgram(ToAdress, FileName, Subject, PlaceToStoreEmailTemplate)
Dim VBAOutlookEmailSend As Object, vItem As Object, vStr As String
Set VBAOutlookEmailSend = CreateObject("Outlook.Application")
Dim temp2 As String
temp2 = FileName
Set vItem = VBAOutlookEmailSend.CreateItemFromTemplate(PlaceToStoreEmailTemplate + temp2 + ".oft")
vItem.Subject = Subject
Dim ToContact As Outlook.Recipient
Set ToContact = vItem.Recipients.Add(ToAdress)
vItem.ReadReceiptRequested = False
vItem.Send
Set vItem = Nothing
Set VBAOutlookEmailSend = Nothing
End Sub
Public Sub LoadNoMailList(NoMailList)
rad = 0
While Range("g14").Offset(rad, 0).Value <> tom
NoMailList(rad + 1) = Range("g14").Offset(rad, 0).Value
rad = rad + 1
Wend
End Sub
Public Sub MatchAdressWithNoMailList(ToAdress, Funnen, NoMailList)
Funnen = False
plats = 1
While NoMailList(plats) <> tom
komp = InStr(ToAdress, NoMailList(plats))
If komp <> 0 Then Funnen = True
plats = plats + 1
Wend
End Sub
Public Sub WaitTimeProgram(sek)
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + sek
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
End Sub
डाउनलोड फ़ाइल Excel!Email_Sender_VBA_Outlook.xls |
