E-post Avsändare VBA Outlook

Email Sender VBA Outlook är ett e-post program som skickar e-post genom att kommunicera med Microsoft Outlook.

Förklaring

Email Sender VBA Outlook är ett VBA Excel program som kommunicerar med Microsoft Outlook. Programmet skickar e-mallar från en fördefinierad plats på din dator måste den fil som ska ett. Ofta fil. Det finns också en funktion för att blockera vissa e-postadresser. Programmet kräver hänvisningen "" Microsoft Outlook XX.X Object Library är aktiverat.

Hela VBA Excel-programmet finns att ladda ner längst ner på denna sida, njut!

Kod

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
Angående = Range ("D14"). Offset (RowA, 0) .Value
Filnamn = Range ("D14"). Offset (RowA, 0) .Value
Call WaitTimeProgram (WaitTimeSecondsBetweenMail)
Angående = Range ("E14"). Offset (RowA, 0) .Value
Call MatchAdress With NoMailList (ToAdress, Funnen, NoMailList)
If Funnen = False Then
Call EmailSenderProgram (ToAdress, Filnamn, Ämne PlaceToStoreEmailTemplate)
End If
RowA = RowA + 1
Wend

End Sub

Sub EmailSenderProgram (ToAdress, Filnamn, Ämne PlaceToStoreEmailTemplate)

Dim VBAOutlookEmailSend As Objekt, vItem As Objekt, vStr As String
Set VBAOutlookEmailSend = CreateObject ("Outlook.Application")
Dim temp2 As String
temp2 = Filnamn
Set vItem = VBAOutlookEmailSend.CreateItemFromTemplate (PlaceToStoreEmailTemplate + temp2 + ". OFT)
vItem.Subject = Ämne
Dim i kontakt As Outlook.Recipient
Set i kontakt = 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 MatchAdress With NoMailList (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 = Andra (Now()) + kr
waitTime = TimeSerial (newHour, newMinute, newSecond)
Application.Wait waitTime

End Sub


Ladda ner Excel-fil!Email_Sender_VBA_Outlook.xls

 

Add your comment

Your name:
Subject:
Comment: