Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.04.2024 20:05:21
CreateObject auf MacOS
28.04.2024 18:33:31
Excel Fenster fixieren
28.04.2024 18:25:12
Excel Aufbauende Summe
28.04.2024 14:18:05
Einfügen ohne Select
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1916to1920
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1916to1920
1916to1920
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Code Erklärung

Code Erklärung
08.02.2023 10:30:49
Thomas
Hallo, Folgender Code soll bei E-Mail Eingang die Email und den Termin aus dem Kalender löschen. Ich möchte aber, das wenn ein Wort im Betreff sind, das dann Email und Termin aus dem Kalender gelöscht wird. Frage: Muss der exakte Titel in den Code oder reicht ein Wort? Wie füge ich ein weiteres Wort hinzu, reicht -> If VBA.InStr(xMeeting.Subject, "Wort1, Wort2") 
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
  Dim xEntryIDs
  Dim xItem
  Dim i As Integer
 Dim xMeeting As MeetingItem, xMeetingDeclined As MeetingItem
  Dim xAppointmentItem As AppointmentItem
 On Error Resume Next
  xEntryIDs = Split(EntryIDCollection, ",")
  For i = 0 To UBound(xEntryIDs)
      Set xItem = Application.Session.GetItemFromID(xEntryIDs(i))
      If xItem.Class = olMeetingRequest Then
          Set xMeeting = xItem
          xMeeting.ReminderSet = False
                    If VBA.InStr(xMeeting.Subject, "Interieur") > 0 Then   'Specify the person and keyword you need TEST
              Set xAppointmentItem = xMeeting.GetAssociatedAppointment(True)
              'xAppointmentItem.ReminderSet = False
              'Set xMeetingDeclined = xAppointmentItem.Respond(olMeetingDeclined)
              'xMeetingDeclined.Body = "Dear, " & vbCrLf & _
                                      "I am not at office. " & vbCrLf & _
                                      "I'm sorry that I will not attend the meeting invitations."
              'xMeetingDeclined.Send
              xAppointmentItem.Delete
              xMeeting.Delete
          End If
      End If
  Next
End Sub

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Code Erklärung
08.02.2023 10:51:55
Der
Hallo,
Deine Frage ist nicht sehr präzise formuliert.
Dein derzeitiger Code sucht im Betreff nach dem Wort "Interieur" und löscht dann. Es reicht, wenn das Wort vorkommt. Wenn Du die Wortliste erweitern willst (habe ich so aus Deiner Frage herausgelesen ...?) dann könntest Du das mit oder in einer if-Abfrage machen, wenn es nur wenige Begriffe sind (für mein Empfinden nicht mehr als 3). Alternativ kannst Du eine Array-Variable mit den Begriffen füllen und diese dann vergleichen.
Gruß
Michael
AW: Code Erklärung
08.02.2023 11:20:04
Thomas
Hallo Michael
Genau richtig verstanden.
Ich denke, das dann die Array-Variable für mich in Frage kommt.
Leider weiß ich nur nicht, wie ich das in den Code einbaue...
Das deklarieren habe ich glaube ich gefunden, aber wie baue ich das ein.
Dim IntA(1 To 4) As Integer
'Das Array initialisieren
IntA(1) = Wort1
IntA(2) = Wort2
IntA(3) = Wort3
IntA(4) = Wort4
Anzeige
AW: Code Erklärung
08.02.2023 12:19:19
Der
Ich würde das in eine separate Funktion auslagern, dort kannst Du dann die Wortliste einpflegen (ich gehe mal davon aus, dass die Begriffe sich nicht dauernd ändern):
Function deleteItem(ByVal sSearch As String) As Boolean
    Dim arrList() As Variant
    Dim i As Long
    arrList = Array("Interieur", "Exterieur", "Superior")
    For i = 0 To UBound(arrList)
        If InStr(sSearch, arrList(i))  > 0Then
            deleteItem = True
            Exit Function
        End If
    Next
End Function
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    Dim xEntryIDs
    Dim xItem
    Dim i As Integer
   Dim xMeeting As MeetingItem, xMeetingDeclined As MeetingItem
    Dim xAppointmentItem As AppointmentItem
   On Error Resume Next
    xEntryIDs = Split(EntryIDCollection, ",")
    For i = 0 To UBound(xEntryIDs)
        Set xItem = Application.Session.GetItemFromID(xEntryIDs(i))
        If xItem.Class = olMeetingRequest Then
            Set xMeeting = xItem
            xMeeting.ReminderSet = False
            If seleteItem(xMeeting.Subject) Then   'Specify the person and keyword you need TEST
                Set xAppointmentItem = xMeeting.GetAssociatedAppointment(True)
                'xAppointmentItem.ReminderSet = False
                'Set xMeetingDeclined = xAppointmentItem.Respond(olMeetingDeclined)
                'xMeetingDeclined.Body = "Dear, " & vbCrLf & _
                                        "I am not at office. " & vbCrLf & _
                                        "I'm sorry that I will not attend the meeting invitations."
                'xMeetingDeclined.Send
                xAppointmentItem.Delete
                xMeeting.Delete
            End If
        End If
    Next
  End Sub
Instr arbeitet per Default case sensitiv, sprich Groß- und Kleinschreibung wird beachtet. Wenn Du also im Betreff "interieur" stehen hast findet er es nicht, wenn du nach "Interieur" suchst. Wenn Du Groß- und Kleinschreibung nicht beachten willst, kannst Du als letzten Parameter vbTextCompare angeben:
        If InStr(sSearch, arrList(i), vbTextCompare) Then
oder Du wandelst den String vorab in Kleinbuchstaben um und vergleichst dann nur damit:
Function deleteItem(ByVal sSearch As String) As Boolean
    Dim arrList() As Variant
    Dim i As Long
    arrList = Array("interieur", "exterieur", "superior")
    sSearch = lcase(sSearch)
For i = 0 To UBound(arrList)
        If InStr(sSearch, arrList(i)) > 0 Then
            deleteItem = True
            Exit Function
        End If
    Next
End Function

Anzeige
AW: Code Erklärung
08.02.2023 13:01:48
Thomas
Danke für die schnelle
Habe den Code eingefügt, als ein Termin kam, indem keiner dieser "Wörter" war, bliebt der Code an dieser stelle hängen:
If seleteItem(xMeeting.Subject) Then 'Specify the person and keyword you need TEST
hier den Code den ich eingesetzt habe:
Function deleteItem(ByVal sSearch As String) As Boolean
    Dim arrList() As Variant
    Dim i As Long
    arrList = Array("Interieur", "Exterieur", "Superior")
    For i = 0 To UBound(arrList)
        If InStr(sSearch, arrList(i))  > 0Then
            deleteItem = True
            Exit Function
        End If
    Next
End Function
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    Dim xEntryIDs
    Dim xItem
    Dim i As Integer
   Dim xMeeting As MeetingItem, xMeetingDeclined As MeetingItem
    Dim xAppointmentItem As AppointmentItem
   On Error Resume Next
    xEntryIDs = Split(EntryIDCollection, ",")
    For i = 0 To UBound(xEntryIDs)
        Set xItem = Application.Session.GetItemFromID(xEntryIDs(i))
        If xItem.Class = olMeetingRequest Then
            Set xMeeting = xItem
            xMeeting.ReminderSet = False
            If seleteItem(xMeeting.Subject) Then   'Specify the person and keyword you need TEST
                Set xAppointmentItem = xMeeting.GetAssociatedAppointment(True)
                'xAppointmentItem.ReminderSet = False
                'Set xMeetingDeclined = xAppointmentItem.Respond(olMeetingDeclined)
                'xMeetingDeclined.Body = "Dear, " & vbCrLf & _
                                        "I am not at office. " & vbCrLf & _
                                        "I'm sorry that I will not attend the meeting invitations."
                'xMeetingDeclined.Send
                xAppointmentItem.Delete
                xMeeting.Delete
            End If
        End If
    Next
  End Sub

Anzeige
AW: Code Erklärung
08.02.2023 13:34:12
Der
Tippfehler meinerseits, hätte man aber erkennen können ;)
If deleteItem(xMeeting.Subject) Then   'Specify the person and keyword you need TEST

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige