Email uit Excel met aantal voorwaarden

[jurgenvo]

Hallo allemaal,

Hier mijn situatie:
Ik heb een bestand gemaakt voor een keukencentrum.
Hierin wordt ingevoerd aan wie verkocht, door wie, wanneer en dat soort dingen.
Nu is er ook een bepaalde datum dat een keuken besteld moet worden.
Ik heb het zo gemaakt dat er zodra een keuken besteld moet worden een melding weergegeven wordt. (melding komt in kolom M)
In kolom H komen de initialen van de verschillende verkopers te staan.
Nu wil ik dus zodra er in kolom M een melding komt automatisch een mailtje laten sturen naar de verkoper die in dezelfde rij in kolom H zijn initialen heeft staan.
Dat mailtje zou ook nog van te voren opgesteld moeten zijn (als een soort concept)

Ik hoop dat jullie hier wat mee kunnen??
Ik weet ook überhaupt niet of het wel mogelijk is om het zo complex te maken...

Ik hoor het wel.

Groeten,

Jurgen

 

[Roncancio]

Een voorbeeld:

Sub Verzenden()
    Dim olApp As Outlook.Application
    Dim olMail As MailItem
    Dim CurrFile As String

    Set olApp = New Outlook.Application
    Set olMail = olApp.CreateItem(olMailItem)
    ActiveWorkbook.Save
    CurrFile = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name

    With olMail
        .To = ActiveSheet.Range("I1")
        .Subject = "Project"
        .Body = ActiveSheet.Range("D4").Text & vbCrLf & ActiveSheet.Range("D5").Text
'        .Attachments.Add CurrFile
'        .Attachments.Add "C:\TEST.xls"
        .Display
        .Send
    End With

    Set olMail = Nothing
    Set olApp = Nothing
End Sub

Bovenstaande code stuurt een email naar het adres dat in cel I1 staat. Het onderwerp is Project (zou je kunnen verwijzen naar een cel) en de tekst staat in de cellen D4 en D5.
Eventueel (staat achter ' ) kun je bestanden toevoegen. In dit geval het huidige bestand en het bestand Test dat op de C-directory staat.
Als je een beetje thuis bent met VBA, kan je hiermee verder.

Met vriendelijke groet,


Roncancio

 

[jurgenvo]

Ik heb zoiets geprobeerd...
Kan iemand mij uitleggen waarom er niks verzonden wordt???

Sub EmailMeldingen()
    #If H19 = "Jurgen" And N19 = "MELDING" Then
        Sub Mail_with_outlook()
            Dim OutApp As Object
            Dim OutMail As Object
            Dim strto As String, strcc As String, strbcc As String
            Dim strsub As String, strbody As String
 
            Set OutApp = CreateObject("Outlook.Application")
            OutApp.Session.Logon
            Set OutMail = OutApp.CreateItem(0)
 
            strto = "jurgen.vanoostenbrugge@tieleman.nl"
            strcc = ""
            strbcc = ""
            strsub = "A19"
            strbody = "Hallo" & vbNewLine & vbNewLine & _
              "Hierbij een herinnering dat de sluitingsdatum van deze klant over 2 weken verloopt" & vbNewLine & vbNewLine & _
              "Graag zo snel mogelijk alle gegevens via Jaap Zijlmans bij de bouwer bezorgen"
 
            With OutMail
            .To = strto
            .CC = strcc
            .BCC = strbcc
            .Subject = strsub
            .Body = strbody
            .Send
            End With
 
            Set OutMail = Nothing
            Set OutApp = Nothing
        End Sub
    
    #Else
    #End If

End Sub

 

[Roncancio]

Kan iemand mij uitleggen waarom er niks verzonden wordt???

Je hebt een Sub in een Sub en dat gaat niet goed.
Verder hoef je geen # te gebruiken.
Bovendien moet je de celverwijzingen in een Range zetten anders herkent VBA dat niet.

Onderstaande versie werkt bij mij wel.

Sub EmailMeldingen()
    If Range("H19").Value = "Jurgen" And Range("N19").Value = "MELDING" Then
            Dim OutApp As Object
            Dim OutMail As Object
            Dim strto As String, strcc As String, strbcc As String
            Dim strsub As String, strbody As String
 
            Set OutApp = CreateObject("Outlook.Application")
            OutApp.Session.Logon
            Set OutMail = OutApp.CreateItem(0)
 
            strto = "jurgen.vanoostenbrugge@tieleman.nl"
            strcc = ""
            strbcc = ""
            strsub = Range("A19").Value
            strbody = "Hallo" & vbNewLine & vbNewLine & _
              "Hierbij een herinnering dat de sluitingsdatum van deze klant over 2 weken verloopt" & vbNewLine & vbNewLine & _
              "Graag zo snel mogelijk alle gegevens via Jaap Zijlmans bij de bouwer bezorgen"
 
            With OutMail
            .To = strto
            .CC = strcc
            .BCC = strbcc
            .Subject = strsub
            .Body = strbody
            .Send
            End With
 
            Set OutMail = Nothing
            Set OutApp = Nothing
    
    End If

End Sub

Met vriendelijke groet,


Roncancio

 

[jurgenvo]

Dit werkt inderdaad geweldig! super!
Nu dan nog 1 klein dingetje...
is er een mogelijkheid om kolom H in te stellen als Range en dan horizontaal vergelijken met de kolom N (ipv N19) en dan ook als subject van het bericht horizontaal naar kolom A te kijken???

Dan zouden al mijn problemen wat dit bestand betreft opgelost zijn.
Alvast bedankt!

 

[Roncancio]

Sub EmailMeldingen()
Dim OutApp As Object
Dim OutMail As Object
Dim strto As String, strcc As String, strbcc As String
Dim strsub As String, strbody As String
Dim lRij As Long
    lRij = 1
    While Range("A" & lRij).Value <> ""
       If Range("H" & lRij).Value = "Jurgen" And Range("N" & lRij).Value = "MELDING" Then
    
           Set OutApp = CreateObject("Outlook.Application")
           OutApp.Session.Logon
           Set OutMail = OutApp.CreateItem(0)

           strto = "jurgen.vanoostenbrugge@tieleman.nl"
           strcc = ""
           strbcc = ""
           strsub = Range("A" & lRij).Value
           strbody = "Hallo" & vbNewLine & vbNewLine & _
             "Hierbij een herinnering dat de sluitingsdatum van deze klant over 2 weken verloopt" & vbNewLine & vbNewLine & _
             "Graag zo snel mogelijk alle gegevens via Jaap Zijlmans bij de bouwer bezorgen"

           With OutMail
           .To = strto
           .CC = strcc
           .BCC = strbcc
           .Subject = strsub
           .Body = strbody
           .Send
           End With

           Set OutMail = Nothing
           Set OutApp = Nothing
       
       End If
       lRij = lRij + 1
    Wend
End Sub

Bovenstaande code is idem als de voorafgaande code.
Alleen wordt nu in 1 keer de emails aangemaakt.
De macro controleert in de A-kolom (vanaf rij 1) totdat een lege cel wordt gevonden.

Met vriendelijke groet,


Roncancio