Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Eintrag Termin Kalender Outlook

Betrifft: Eintrag Termin Kalender Outlook von: Mulsch0r
Geschrieben am: 27.08.2014 14:32:31

Hallo,

ich möchte aus meiner do do Liste wenn ich die Zelle M1:M100 anklicke das zum einem eine email versendet und zum anderen ein Termin angelegt wird.

Beides Funktioniert. Nun möchte ich aber auch das die beteiligeten Kollegen auch einen Termin bekommen bzw mit eingeladen werden.

'Öffnet mit Linksklick auf Zellen der Spalten H,I,J einen Kalender.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("H4:H100")) Is Nothing Then Call OpenCalender
    If Not Intersect(Target, Range("I4:I100")) Is Nothing Then Call OpenCalender
    If Not Intersect(Target, Range("J4:J100")) Is Nothing Then Call OpenCalender

 'Öffnet mit Linksklick auf Zellen der Spalten M Outlook.
    If Not Intersect(Target, Tabelle2.Range("M4:M100")) Is Nothing Then
        Call sendEmail(zeile:=Target.Row)
 End If
 
 'Eintrag Termin in Outlook, sowie der mitwirkenden Mitarbeiter
   If Not Intersect(Target, Tabelle2.Range("M4:M100")) Is Nothing Then
        Call Outlook
        
  End If
  
    
End Sub

Sub Outlook()

Dim OutApp
Dim apptOutApp
Set OutApp = CreateObject("Outlook.Application")
Set apptOutApp = OutApp.CreateItem(1)
With apptOutApp
.Start = "28.08.2014" & " 18:00"
.Subject = "Test"
.Body = "Text"
.Location = "Testort"
.Duration = "19"
.Recipients.Add Tabelle2.Range("N" & zeile)
.ReminderMinutesBeforeStart = 10
.ReminderPlaySound = True
.ReminderSet = True
.Save
End With

Set apptOutApp = Nothing
Set OutApp = Nothing

MsgBox "E-Mail wurde verschickt und Termin angelegt"

End Sub Ich dachte ich könnte die Range, für die Adressen genau so anwenden wie bei deim
versenden der E-Mail. sendto = Tabelle2.Range("N" & zeile) aber das funktioniert nicht.

Noch mal kurz: Der befehl .Recipients.Add Tabelle2.Range("N" & zeile) funktioniert bei mir nicht. Was kann ich tun?

Gruß

Mulsch0r

Hier nochmal der gesamte Code falls es sonst zu Missverständissen kommt.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim TRow As Integer
TRow = Target.Row


If Target.Column = 12 Then
    If Target = "Erledigt" Then
        Sheets("Aufgaben").Rows(TRow).Copy
        Sheets("Erledigt").Cells(Sheets("Erledigt").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0). _
Row, 1).PasteSpecial
        Sheets("Aufgaben").Rows(TRow).Delete Shift:=xlUp
    End If
End If

End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("H4:H100")) Is Nothing Then Call OpenCalender
    If Not Intersect(Target, Range("I4:I100")) Is Nothing Then Call OpenCalender
    If Not Intersect(Target, Range("J4:J100")) Is Nothing Then Call OpenCalender

 
    If Not Intersect(Target, Tabelle2.Range("M4:M100")) Is Nothing Then
        Call sendEmail(zeile:=Target.Row)
 End If
 
    If Not Intersect(Target, Tabelle2.Range("M4:M100")) Is Nothing Then
        Call Outlook
        
  End If
  
    
End Sub

Public Function sendEmail(zeile As Long)
On Error GoTo ende

esubject = "Bitte folgende Aufgabe(n) erledigen"

sendto = Tabelle2.Range("N" & zeile)

ebody = "Hallo," & vbCrLf & vbCrLf & _
        "Projekt: " & Tabelle2.Range("C" & zeile) & vbCrLf & _
        "Auftrag: " & Tabelle2.Range("D" & zeile) & vbCrLf & _
        "Verantwortlicher: " & Tabelle2.Range("E" & zeile) & vbCrLf & _
        "Mitarbeiter: " & Tabelle2.Range("F" & zeile) & vbCrLf & vbCrLf & _
        "Aufgabe: " & Tabelle2.Range("G" & zeile) & vbCrLf & _
        "Start Aufgabe:    " & Tabelle2.Range("H" & zeile) & vbCrLf & _
        "Kontrolltermin:  " & Tabelle2.Range("I" & zeile) & vbCrLf & _
        "Abgabetermin:   " & Tabelle2.Range("J" & zeile) & vbCrLf & _
        "Bemerkung: " & Tabelle2.Range("K" & zeile) & vbCrLf & _
        "Projetpfad: " & Tabelle2.Range("O" & zeile) & vbCrLf
        newfilename = "U:\Test.pdf"

Set app = CreateObject("outlook.Application")
Set itm = app.CreateItem(0)

With itm
.Subject = esubject
.to = sendto
.cc = ccto
.Body = ebody
.attachments.Add (newfilename)
.display
.send
End With
Set app = Nothing
Set itm = Nothing
ende:
End Function


Sub Outlook()

Dim OutApp
Dim apptOutApp
Set OutApp = CreateObject("Outlook.Application")
Set apptOutApp = OutApp.CreateItem(1)
With apptOutApp
.Start = "28.08.2014" & " 18:00"
.Subject = "Test"
.Body = "Text"
.Location = "Testort"
.Duration = "19"
'.Recipients.Add Tabelle2.Range("N" & zeile)
.ReminderMinutesBeforeStart = 10
.ReminderPlaySound = True
.ReminderSet = True
.Save
End With

Set apptOutApp = Nothing
Set OutApp = Nothing

MsgBox "E-Mail wurde verschickt und Termin angelegt"

End Sub

  

Betrifft: AW: Eintrag Termin Kalender Outlook von: Frank
Geschrieben am: 27.08.2014 19:06:09

Hallo,

ich weiss zwar nicht, ob ich die Lösung des Problems kenne, aber allen anderen würde es sicher auch helfen, wenn Du Der befehl .Recipients.Add Tabelle2.Range("N" & zeile) funktioniert bei mir nicht. etwas näher definieren würdest.
Kommt eine Fehlermeldung? Passiert nichts, wo etwas passieren sollte? Hängt sich XL auf und reissst Dein BS mit in den Abgrund?
Das könnten alles Hinweise sein, woran es liegt

Grüsse,
Frank


  

Betrifft: AW: Eintrag Termin Kalender Outlook von: Mulsch0r
Geschrieben am: 28.08.2014 09:07:25

Hallo Frank,
guten Morgen an alle,

ich drück normalerweise auf eine Zelle in der Spalte N und ich verschicke automatisch eine E-Mail mit allesn relavanten Daten für ein Projekt. Jetzt wollte ich auch noch Termine setzten für mich und für die Kollegen die es betrifft. Drücke ich jetzt die Zelle geht die E-Mail raus an mich und den Kollegen, aber nur bei mir wird der Termin eingetragen. Es kommt jetzt der Fehler laufzeitfehler 449 Argument ist nicht optional.

Ich bin leider noch nicht so fitt. Ich versuche aber immer alles nachzuvollziehen. Für mich war jetzt Logisch das ich es genau so machen könnte wie bei der E-Mail also so....

Auszüge des Codes ich werde die Tabell mal mit hochladen.

If Not Intersect(Target, Tabelle2.Range("M4:M100")) Is Nothing Then
Call sendEmail(zeile:=Target.Row)

If Not Intersect(Target, Tabelle2.Range("M4:M100")) Is Nothing Then
Call Outlook(Test:=Target.Row)


Public Function sendEmail(zeile As Long)
Sub Outlook(Test As Long)

sendto = Tabelle2.Range("N" & zeile)
.Recipients.Add = Tabelle2.Range("N" & Test)


Hier der Link zu meiner todoList

https://www.herber.de/bbs/user/92338.xlsm


Scheinbar geht es aber nicht so einfach wie ich dachte. Wie schon erwähnt ich verstehe noch nicht alles, aber ich bin bemüht dazu zu lernen und erwarte auch keinen fertigen Code.

Gruß

Mulsch0r


  

Betrifft: Methode prüfen von: Frank
Geschrieben am: 28.08.2014 10:51:20

Guten Morgen,

die von Dir verwendete Form .Recipients.Add = Tabelle2.Range("N" & Test) finde ich so in meiner Online-Hilfe nicht. Das kann aber daran liegen, dass ich nicht die aktuellste Software verwende :-)
Gemäss dieser Info wird das so erwartet

ActiveWorkbook.SendMail recipients:="Jean Selva"
zum Verschicken an einen Empfänger, oder so

.Recipients = Array("Adam Bendel", "Jean Selva", "Bernard Gabor")
bei mehreren Empfängern.
Das gilt aber für die SendMail-Methode von XL und nicht für die Outlook-Application. Da müsste man eventuell dort in der Online-Hilfe für VBA nachsehen.
Was auf jedenFall zu empfehlen ist, hänge ein .value an Deine Zellbezüge dran.

Grüsse,
Frank


  

Betrifft: AW: Methode prüfen von: Mulsch0r
Geschrieben am: 28.08.2014 11:31:22

Hi das ist leider nicht was ich benötige. Ich glaube aber auch das es nicht wichtig ist das andere auch einen termin bekommen es reicht eigentlich völlig aus das ich einen bekomme und das funktioniert ja. Trozdem vielen dank für die Mühe


 

Beiträge aus den Excel-Beispielen zum Thema "Eintrag Termin Kalender Outlook"