Outlook Eintrag via Excel erstellen (Surface)

  • Excel

Es gibt 2 Antworten in diesem Thema. Der letzte Beitrag () ist von Jabba the Playa.

    Outlook Eintrag via Excel erstellen (Surface)

    Guten Morgen liebe Community,

    ich habe für einen Freund gestern einen Code geschrieben, der für ihn automatisiert Kalendereinträge erstellen soll.
    Auf meinem Rechner funktioniert soweit auch alles.

    Bei ihm kommt die Meldung, dass er Outlook installieren soll. Wenn er auf weiter klickt, geschieht nichts.
    Excel und Outlook sind auf dem Surface installiert. Andere Makros von mir funktionieren bereits auf dem Surface, arbeiten aber nur intern in Excel Punkte ab.

    Ist meine Variante Outlook anzusprechen die falsche auf einem Surface? Gibt es da Unterschiede?

    Gruß Daniel

    PS: hier noch der Code

    Quellcode

    1. Private Sub CommandButton1_Click()
    2. Dim datum As Date
    3. Dim dt As String, tag As String, monat As String, jahr As String
    4. Dim Beginn As String, Betreff As String
    7. monat = Cells(6, 2).Value
    8. jahr = Cells(7, 2).Value
    10. For zaehler = 9 To 39
    11. tag = Cells(zaehler, 2).Value
    12. dt = tag & "." & monat & "." & jahr
    14. If IsDate(dt) Then
    15. If Not Cells(zaehler, 1).Value = "Sa" Then
    16. If Not Cells(zaehler, 1).Value = "So" Then
    17. datum = Format(dt, "DD.MMM")
    19. With Excel.Selection
    20. Beginn = datum
    21. Betreff = "Aktion: " & Cells(zaehler, 7)
    23. Kalendereintrag_erstellen Beginn, Betreff
    24. End With
    25. End If
    26. End If
    27. End If
    28. Next zaehler
    29. End Sub
    31. Public Sub Kalendereintrag_erstellen(Beginn As String, Betreff As String)
    33. Set OutApp = CreateObject("Outlook.Application")
    35. Set apptOutApp = OutApp.CreateItem(1)
    36. With apptOutApp
    37. .AllDayEvent = True
    38. .Start = Beginn
    39. .Subject = Betreff
    40. .ReminderSet = False
    41. .Save
    42. End With
    44. Set apptOutApp = Nothing
    45. Set OutApp = Nothing
    46. lvOutlook = True
    47. Exit Sub
    49. ErrOutLook:
    50. Set apptOutApp = Nothing
    51. Set OutApp = Nothing
    52. lvOutlook = False
    53. MsgBox "Termin konnte in Outlook nicht eingetragen werden. Fehler:" & Err.Description & ". Melde dich bei Daniel!"
    54. End Sub

Facebook
Telefonspende