• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Syntaxisfout bij automatische e-mail

  • Onderwerp starter Onderwerp starter wheel
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.
W

wheel

Gebruiker
Lid geworden
6 nov 2009
Berichten
281
Zeer gewaardeerde helpers,

Ik probeer nu een e-mail automatisch te laten versturen als in het bereik F3:F27 de waarde meer dan 170.000 km bereikt.

Maar ergens gaat het de mist in, want ik krijg een syntaxisfout op het vet gedrukte. Alleen snap ik niet zo goed wat. :confused:

Iemand die mij kan assisteren?

Thnx.. Wheel.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Application.Intersect(Range("F3:F27"), Target) Is Nothing Then
        If IsNumeric(Target.Value) And Target.Value > 170000 Then
            [B]Voertuigregistratie.xls!Mail_with_Outlook[/B]
        End If
    End If
End Sub
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 = "mijn@email.nl"
    strcc = ""
    strbcc = ""
    strsub = "Voertuigregistratie"
    strbody = "Let op!" & vbNewLine & vbNewLine & _
              "Een voertuig heeft 170.000 km of meer gereden."
 
    With OutMail
        .To = strto
        .CC = strcc
        .BCC = strbcc
        .Subject = strsub
        .Body = strbody
        .Send
    End With
 
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
 
Ik heb het al opgelost. Zie onderstaande. :D

Nu nog kijken hoe ik die viruswaarschuwing wegkrijg. :confused:

Schouderklopje voor mezelf :D:D


Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Application.Intersect(Range("F3:F27"), Target) Is Nothing Then
        If IsNumeric(Target.Value) And Target.Value > 170000 Then
            [B]kilometers[/B]
        End If
    End If
End Sub
Sub [B]kilometers[/B]()
    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 = "mijn@email.nl"
    strcc = ""
    strbcc = ""
    strsub = "Voertuigregistratie"
    strbody = "Let op!" & vbNewLine & vbNewLine & _
              "Een voertuig heeft 170.000 km of meer gereden."
 
    With OutMail
        .To = strto
        .CC = strcc
        .BCC = strbcc
        .Subject = strsub
        .Body = strbody
        .Send
    End With
 
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
 
Het rode gedeelte kan weg en ik neem aan dat je een verwijzing hebt gemaakt naar Outlook.

Code: 
            [COLOR="Red"][B]Voertuigregistratie.xls![/B][/COLOR]Mail_with_Outlook

Edit: ik zie dat je het al heeft aangepast.:thumb:

Met vriendelijke groet,


Roncancio
 
Hallo Roncancio,

Ik probeer nu ook een Range op te geven die in de mail als regel moet komen, maar dat lukt me niet.

Als de waarde in F3:F27 (waarin de kilometers staan) boven de 170.000 komt, werkt dat perfect en ik krijg ook keurig de melding in de e-mail, maar nu wil ik dat de cellen A3:A27 (waarin de kentekens staan) ook worden vermeld in de mail op een aparte regel.

Ik ben al bezig met het volgende, maar zoals gezegd, ik kom er niet uit:

Code: 
Sub Mail_Range()
    Dim Source As Range
    
        Set Source = Range("A3:A27")

Kun je me op weg helpen?

Thnx..
 
Laat dit nu al voldoende zijn:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Application.Intersect(Range("F3:F27"), Target) Is Nothing Then
        If IsNumeric(Target.Value) And Target.Value > 170000 Then kilometers join(worksheetfunction.transpose(Range("F3:F27")),vbcr)
    End If
End Sub

Sub kilometers(c0)
 With CreateObject("Outlook.Application").CreateItem(0)
    .To = "mijn@email.nl"
    .Subject = "Voertuigregistratie"
    .Body = replace("Let op!##Deze voertuigen hebben 170.000 km of meer gereden.##","#",vbcr) & c0
     .Send
  End With
End Sub
 
Hey snb,

Deze werkt ook super. :thumb:

Echter, in de mail krijg ik de kilometers te zien en niet de kentekens die in kolom A staan.

Als ik
Code: 
Transpose(Range("F3:F27")
aanpas naar A3:A27 laat ie alle kentekens zien en niet alleen degene die boven de 170.000 uitkomen.

Thnx... Wheel.
 
En zojuist zie ik dat als ik een waarde hoger dan 170.000 invoer in bijvoorbeeld cel F25 er in de e-mail een aantal witregels komt en deze waarde niet gewoon op de volgende regel onder de andere tekst wordt weergegeven.. :confused:

Wheel
 
Hoe zou de code moeten weten welke kentekens horen bij auto's met meer dan 170.000 op te teller ?

Deze had je natuurlijk al geprobeerd :

Code: 
If IsNumeric(Target.Value) And Target.Value > 170000 Then kilometers target.offset(,-5)
 
snb zei:
Deze had je natuurlijk al geprobeerd :
Klik om te vergroten...

Eh, misschien als ik mijn boekje over VBA uit heb :o ben pas bij hoofdstukje 3 :D

Dit werkt helemaal perfect. :thumb:

Nog twee vraagjes:

Als ik een melding wil hebben vanaf een waarde boven de 185000 km, kan ik dan gewoon de regel kopiëren en plakken en de waarde aanpassen of werkt dat niet?

Weet je ook hoe ik die viruswaarschuwing wegkrijg? Ik heb al gezocht, maar dan moet je iets installeren over Outlook Redemption. Ik kan op de zaak niets installeren :confused:

Gr. Wheel.
 
Als ik een melding wil hebben vanaf een waarde boven de 185000 km, kan ik dan gewoon de regel kopiëren en plakken en de waarde aanpassen of werkt dat niet?
Klik om te vergroten...
Ik ben benieuwd naar de resultaten van je tests.

In welk VBA-boek ben je bezig ?
 
Hoort eigenlijk thuis in de Outlook afdeling, maar als je deze code in Outlook zet bij de module ThisOutlookSession, ben je waarschijnlijk van de emailvertraging af.

' FnSendMailSafe
' --------------
' Simply sends an e-mail using Outlook/Simple MAPI.
' Calling this function by Automation will prevent the warnings
' 'A program is trying to send a mesage on your behalf...'
' Also features optional HTML message body and attachments by file path.
'
' The To/CC/BCC/Attachments function parameters can contain multiple items by seperating
' them by a semicolon. (e.g. for the strTo parameter, 'test@test.com; test2@test.com' is
' acceptable for sending to multiple recipients.
'
Code: 
Public Function FnSendMailSafe(strTo As String, _
      strCC As String, _
      strBCC As String, _
      strSubject As String, _
      strMessageBody As String, _
      Optional strAttachments As String) As Boolean

' (c) 2005 Wayne Phillips - Written 07/05/2005
' Last updated 26/03/2008 - Bugfix for empty recipient strings
' http://www.everythingaccess.com

On Error GoTo ErrorHandler:

Dim MAPISession As Outlook.NameSpace
Dim MAPIFolder As Outlook.MAPIFolder
Dim MAPIMailItem As Outlook.MailItem
Dim oRecipient As Outlook.Recipient
Dim TempArray() As String
Dim varArrayItem As Variant
Dim strEmailAddress As String
Dim strAttachmentPath As String
Dim blnSuccessful As Boolean

    'Get the MAPI NameSpace object
    Set MAPISession = Application.Session
    
    If Not MAPISession Is Nothing Then
        'Logon to the MAPI session
        MAPISession.Logon , , True, False
        'Create a pointer to the Outbox folder
        Set MAPIFolder = MAPISession.GetDefaultFolder(olFolderOutbox)
        If Not MAPIFolder Is Nothing Then
            'Create a new mail item in the "Outbox" folder
            Set MAPIMailItem = MAPIFolder.Items.Add(olMailItem)
            If Not MAPIMailItem Is Nothing Then
                With MAPIMailItem
                    'Create the recipients TO
                    TempArray = Split(strTo, ";")
                    For Each varArrayItem In TempArray
                        strEmailAddress = Trim(varArrayItem)
                        If Len(strEmailAddress) > 0 Then
                            Set oRecipient = .Recipients.Add(strEmailAddress)
                            oRecipient.Type = olTo
                            Set oRecipient = Nothing
                        End If
                    Next varArrayItem
                    'Create the recipients CC
                    TempArray = Split(strCC, ";")
                    For Each varArrayItem In TempArray
                        strEmailAddress = Trim(varArrayItem)
                        If Len(strEmailAddress) > 0 Then
                            Set oRecipient = .Recipients.Add(strEmailAddress)
                            oRecipient.Type = olCC
                            Set oRecipient = Nothing
                        End If
                    Next varArrayItem
                    'Create the recipients BCC
                    TempArray = Split(strBCC, ";")
                    For Each varArrayItem In TempArray
                        strEmailAddress = Trim(varArrayItem)
                        If Len(strEmailAddress) > 0 Then
                            Set oRecipient = .Recipients.Add(strEmailAddress)
                            oRecipient.Type = olBCC
                            Set oRecipient = Nothing
                        End If
                    Next varArrayItem
                    'Set the message SUBJECT
                    .Subject = strSubject
                    'Set the message BODY (HTML or plain text)
                    If StrComp(Left(strMessageBody, 6), "<HTML>", vbTextCompare) = 0 Then
                        .HTMLBody = strMessageBody
                    Else
                        .Body = strMessageBody
                    End If
                    'Add any specified attachments
                    TempArray = Split(strAttachments, ";")
                    For Each varArrayItem In TempArray
                        strAttachmentPath = Trim(varArrayItem)
                            If Len(strAttachmentPath) > 0 Then
                            .Attachments.Add strAttachmentPath
                            End If
                    Next varArrayItem
                    .Send 'No return value since the message will remain in the outbox if it fails to send
                    Set MAPIMailItem = Nothing
                End With
            End If
            Set MAPIFolder = Nothing
        End If
        MAPISession.Logoff
    End If
    
    'If we got to here, then we shall assume everything went ok.
    blnSuccessful = True
    
ExitRoutine:
    Set MAPISession = Nothing
    FnSendMailSafe = blnSuccessful
    
    Exit Function
    
ErrorHandler:
    MsgBox "An error has occured in the user defined Outlook VBA function FnSendMailSafe()" & vbCrLf & vbCrLf & _
            "Error Number: " & CStr(Err.Number) & vbCrLf & _
            "Error Description: " & Err.Description, vbApplicationModal + vbCritical
    Resume ExitRoutine

End Function
 
Waardes boven de 170.000 werken gewoon en als ik daarna boven de 185.000 kom, dan krijg ik meerdere keren die viruswaarschuwing en ook meerdere mails. Alleen, de output in die mails blijft gelijk aan 170.000. :confused:

Boekje is Macro's en VBA in Excel 2007 :thumb:

Wheel.
 
@ OctaFish,

Ik heb geen flauw idee waarover je het hebt. :o:o

Van een e-mailvertraging heb ik geen enkel last. Die komt meteen binnen.

Wheel.
 
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Application.Intersect(Range("F3:F27"), Target) Is Nothing Then
        If IsNumeric(Target.Value) And Target.Value > 170000 Then kilometers target, target.offset(,-5)
    End If
End Sub

Sub kilometers(c0,c1)
 With CreateObject("Outlook.Application").CreateItem(0)
    .To = "mijn@email.nl"
    .Subject = "Voertuigregistratie"
    .Body = replace("Let op!##Dit voertuig met nummerplaat " & c1 & " heeft " & c0 & " km gereden.","#",vbcr)
     .Send
  End With
End Sub

@OctaFish
Vertel mij eens welke VBA-regel in jouw code de meldingen voorkomt ?
 
snb zei:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Application.Intersect(Range("F3:F27"), Target) Is Nothing Then
        If IsNumeric(Target.Value) And Target.Value > 170000 Then kilometers target, target.offset(,-5)
    End If
End Sub

Sub kilometers(c0,c1)
 With CreateObject("Outlook.Application").CreateItem(0)
    .To = "mijn@email.nl"
    .Subject = "Voertuigregistratie"
    .Body = replace("Let op!##Dit voertuig met nummerplaat " & c1 & " heeft " & c0 & " km gereden.","#",vbcr)
     .Send
  End With
End Sub
Klik om te vergroten...

Momenteel heb ik geen toegang tot mijn zakelijk account, dus kan de bovenstaande code niet testen wat deze doet. Met mijn - nog - beperkte kennis van VBA kan ik er niet uithalen dat deze de waarschuwingsmelding voorkomt. Of?

Heeft iemand een idee hoe deze melding uit te schakelen? Ik kan niets installeren (zoals Outlook Redemption), maar het moet ook geen Outlook afhankelijke code zijn, zoals OctaFish voorstelde. :p

Het bestand staat op een bedrijfsnetwerk en wordt door meerdere personen aangepast op kilometers. De code moet dus in het Excel bestand komen.

Gr. Wheel.
 
Het is een onderdeel van de beveiligingsinstellingen van Outlook in het windowsregister.
 
snb zei:
Het is een onderdeel van de beveiligingsinstellingen van Outlook in het windowsregister.
Klik om te vergroten...

Oke, dan moeten we maar leven met het bestaan van dat irritante venstertje. :confused:

Ik dank je in ieder geval voor alle hulp, want het werkt perfect. :thumb:

Gr. Wheel (die weer eens in zijn boekje duikt) :D
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan