• 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.

Goede VBA code??

Status
Niet open voor verdere reacties.

Jeof1980

Gebruiker
Lid geworden
10 aug 2010
Berichten
30
Ik heb navolgende aansturing geplaats in de VBA:

Private Sub Worksheet_Calculate() voor het verzenden van e-mails.Nu verstuurt hij elke keer als ik iets aanpas in de sheet een e-mail ik zou dit pas willen als 's nachts b.v. 24:00 is en dit elke dag opnieuw.

Waar moet ik bovenstaande VBA code dan voor vervangen?
 
Code:
Application.OnTime TimeValue("0:00:00"), "Verzenden"
Als het 0:00:00 is, dan wordt de macro Verzenden uitgevoerd.

Met vriendelijke groet,


Roncancio
 
Waar moet ik hem invoegen in de VBA, als ik hem vervang voor de bestaande krijg ik een foutmeldingen zou gauw ik iets aanpas in de sheet:confused:

Volgende VBA code heb ik voor het genereren en verzenden van de e-mail:

Private Sub Worksheet_Calculate()
If [o14] = Date And [o14] < [q14] Or [u14] = Date And [u14] < [y14] Or [v14] = Date And [v14] < [y14] Or [v14] - 7 = Date And [v14] < [y14] Then

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
sTo = ActiveSheet.Range("G14")
sCC = ""
sBCC = ""
sSubject = "Overschrijding termijn"
strbody = "Geachte Casemanager," & vbNewLine & vbNewLine & _
"Er is een termijn overschrijding bij navolgende omgevingsvergunning:"

With OutMail
.To = sTo
.CC = sCC
.BCC = sBCC
.Subject = sSubject
.Body = strbody & vbCrLf & vbCrLf & ActiveSheet.Range("A14").Text & vbCrLf & ActiveSheet.Range("B14").Text
.send
End With
Set OutMail = Nothing
Set OutApp = Nothing
End If
End Sub
 
Zet in ThisWorkbook:

Code:
Private Sub Workbook_Open()
Application.OnTime TimeValue("0:00:00"), "Verzenden"

End Sub

Zet in een Module:
Code:
Sub Verzenden()
If [o14] = Date And [o14] < [q14] Or [u14] = Date And [u14] < [y14] Or [v14] = Date And [v14] < [y14] Or [v14] - 7 = Date And [v14] < [y14] Then

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    sSubject = "Overschrijding termijn"
    strbody = "Geachte Casemanager," & vbNewLine & vbNewLine & _
    "Er is een termijn overschrijding bij navolgende omgevingsvergunning:"
    
    With OutMail
        .To = ActiveSheet.Range("G14").Value
        .Subject = sSubject
        .Body = strbody & vbCrLf & vbCrLf & ActiveSheet.Range("A14").Text & vbCrLf & ActiveSheet.Range("B14").Text
        .send
    End With
    Set OutMail = Nothing
    Set OutApp = Nothing
End If
End Sub

Bij het openen wordt de de macro Verzenden ingesteld. Pas als het 0:00 uur is, wordt deze macro daadwerkelijk uitgevoerd.
De computer wacht dus totdat het tijd is met het uitvoeren van de macro Verzenden.

Met vriendelijke groet,


Roncancio
 
Code:
en dit elke dag opnieuw
dat stukje heb je nog niet opgelost !!!:rolleyes:
 
mis dus,
die code wordt eenmalig gestart bij het openen van je werkblad, daarna wacht hij netjes tot 00:00 en laat hij verzenden lopen en als je hem dan niet opnieuw een trap geeft, is het over en uit.
Helemaal in de rand, ik heb ooit nog een keer problemen gehad met 00:00, in op PC maar PLC, want daar was het 23:59:59 naar 24:00:00 naar 00:00:01, tegen je daar achter bent ... . Dus sindsdien bestaat 00:00:00 niet meer bij me
 
hoi

regeltje toegevoegd aan eind van Verzenden

Code:
sub Verzenden()
If [o14] = Date And [o14] < [q14] Or [u14] = Date And [u14] < [y14] Or [v14] = Date And [v14] < [y14] Or [v14] - 7 = Date And [v14] < [y14] Then

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    sSubject = "Overschrijding termijn"
    strbody = "Geachte Casemanager," & vbNewLine & vbNewLine & _
    "Er is een termijn overschrijding bij navolgende omgevingsvergunning:"
    
    With OutMail
        .To = ActiveSheet.Range("G14").Value
        .Subject = sSubject
        .Body = strbody & vbCrLf & vbCrLf & ActiveSheet.Range("A14").Text & vbCrLf & ActiveSheet.Range("B14").Text
        .send
    End With
    Set OutMail = Nothing
    Set OutApp = Nothing
End If
Application.OnTime TimeValue("0:00:00"), "Verzenden"
End Sub

groet sylvester
 
weet iemand misschien hoe ik het geregeld krijg dat ik niet steeds de exel file moet openen maar dat hij gewoon doet verzenden als het tijd is. Het is de bedoeling dat het programma gewoon open blijft staan op de computer en niet elke dag opnieuw geopend wordt.

Met bovenstaande code doet hij slechts verzenden nadat ik de file gesloten heb en opnieuw geopend heb:confused:
 
zo wilde ik die zien, nu werkt het naar behoren, alleen zou je hem misschien nog een keer moeten afmelden bij het sluiten van je bestand, maar dat zijn zorgen voor later
 
hoi

regeltje toegevoegd aan eind van Verzenden

Code:
sub Verzenden()
If [o14] = Date And [o14] < [q14] Or [u14] = Date And [u14] < [y14] Or [v14] = Date And [v14] < [y14] Or [v14] - 7 = Date And [v14] < [y14] Then

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    sSubject = "Overschrijding termijn"
    strbody = "Geachte Casemanager," & vbNewLine & vbNewLine & _
    "Er is een termijn overschrijding bij navolgende omgevingsvergunning:"
    
    With OutMail
        .To = ActiveSheet.Range("G14").Value
        .Subject = sSubject
        .Body = strbody & vbCrLf & vbCrLf & ActiveSheet.Range("A14").Text & vbCrLf & ActiveSheet.Range("B14").Text
        .send
    End With
    Set OutMail = Nothing
    Set OutApp = Nothing
End If
Application.OnTime TimeValue("0:00:00"), "Verzenden"
End Sub

groet sylvester

:thumb:
Oeps, vergeten.
Bedankt voor de correctie.

Met vriendelijke groet,


Roncancio
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan