Anzeige
Archiv - Navigation
992to996
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
992to996
992to996
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Excel-Daten in Outlook Kalender übermitteln

Excel-Daten in Outlook Kalender übermitteln
14.07.2008 10:57:00
Frank
Hallo Experten,
ich möchte aus einer Excel-Datei (Spalte 1:Datum,Spalte2:Text)
Daten in den Kalender von Outlook übermitteln.
Dabei soll der Text(Spalte2) als Termin in dem Datum (Spalte 1)
entsprechenden Kalenderblatt erscheinen.
Im Kalender sind schon andere Termine, die durch die "Excel-Termine"
nicht verändert oder gelöscht werden sollen.
Danke für eure Hilfe

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Excel-Daten in Outlook Kalender übermitteln
14.07.2008 11:41:30
Ramses
Hallo
Den Bereich wo die Daten herkommen musst du halt anpassen
'************************************
'Start Codesequenz
Sub Excel_Control_Termin_nach_Outlook()
    '(C) Ramses
    'E 2000
    'Dim OutApp As Outlook.Application
    Dim OutApp As Object, apptOutApp As Object
    Dim apptFolder As Object
    Dim myC As Range, schedRange As Range
    'Hier beginnen die Termine
    Set schedRange = Range("A5:A100")
    'Outlook initialiseren
    Set OutApp = CreateObject("Outlook.Application")
    'Default Kalender
    Set apptFolder = myOLApp.GetNamespace("MAPI").GetDefaultFolder(9)
    For Each myC In schedRange
        'Wenn in der Zelle was drin steht
        If myC <> "" Then
            'beim ersten Aufruf muss ja noch kein
            'Termin geprüft werden
            If myC.Row > schedRange.Cells(1, 1).Row Then
                'Doppeltermin im Bereich prüfen
                'Kann notfalls entfernt werden
                If checkSchedDate(Range("" & schedRange.Cells(1, 1).Address & ":" & myC.Offset(-1, 0).Address & ""), myC.Value) = True Then
                    'Es hat an diesem Tag schon einen Termin gegeben
                    GoTo nextsched
                End If
                'Prüfen ob der Termin in Outlook schon existiert
                If checkAppt(apptFolder, myC) = True Then
                    Qe = MsgBox("Zu diese Zeitpunkt: """ & myC & """ existiert bereits ein Termin." & vbCrLf & "Termin trotzdem erstellen ?" & _
                    vbCrLf, vbYesNo + vbDefaultButton2, "Doppelter Termin")
                    If Qe = vbYes Then
                        With apptOutApp
                            Set apptOutApp = OutApp.CreateItem(1) 'olAppointmentItem)
                            'Datum und Uhrzeit
                            'Hier werden zum aktuellen Tag 7 Tage addiert
                            'Start = Format(Now() + 7, "dd.mm.yyyy") & " 08:00"
                            'Alternativ werden die Termine aus der Zelle genommen
                            .start = Format(myC.Value, "dd.mm.yyyy") & " 08:00"
                            'Termininfo
                            'Subject = "Rechnung: " & ActiveWorkbook.Name & " kontrollieren"
                            'oder der Betreff steht in der Spalte rechts von den Terminen
                            .Subject = ActiveCell.Offset(0, 1)
                            'Zusätzlicher Text
                            '2 Spalten nach rechts
                            .Body = ActiveCell.Offset(0, 2)
                            'ort =
                            '3 Spalten rechts
                            .Location = ActiveCell.Offset(0, 3)
                            'Dauer. Angabe ist jeweils in ganzen Minuten zu setzen
                            .Duration = "5"
                            'Erinnerung
                            .ReminderMinutesBeforeStart = 10
                            'mit Sound :-)
                            .ReminderPlaySound = True
                            'Erinnerung wiederholen
                            .ReminderSet = True
                            'Termin speichern
                            .Save
                        End With
                    End If
                End If
            End If
        End If
        nextsched:
    Next
    'Nächste Zelle auswählen
    'Variablen leeren,... sonst "kotzt" Outlook irgendwann mal
    Set apptOutApp = Nothing
    Set OutApp = Nothing
    MsgBox "Termine an Outlook übertragen!"
End Sub

Function checkSchedDate(chkRange As Range, chkDate As Date) As Boolean
    '(C) Ramses
    'Es wird geprüft ob in dem bisher abgearbeiteten
    'Bereich bereits das gleiche Datum vorhanden ist
    'Wenn ja, dann wird der übergebene Termin verworfen
    'und nicht nach Outlook übertragen
    Dim chkC As Range
    For Each chkC In chkRange
        If chkC = chkDate Then
            checkSchedDate = True
            Exit Function
        End If
    Next
    checkSchedDate = False
End Function


Function chkAppt(chkFolder As Object, newAppt As String) As Boolean
    '(C) Ramses
    'Es wird geprüft, ob der Termin im Kalender bereits existiert
    Dim appItem As Object
    chkAppt = True
    For Each appItem In chkFolder.Items
    If appItem.Subject = newAppt Then Exit Function
    Next
    chkAppt = False
End Function

'Ende Codesequenz
'********************************************

Existierende Termine werden grundsätzlich nicht überschrieben, sondern allenfalls doppelt angelegt.
Gruss Rainer

Anzeige
AW: Excel-Daten in Outlook Kalender übermitteln
14.07.2008 16:57:20
Frank
folgende Fehlermeldung kommt:
in der Zeile
If checkAppt(apptFolder, myC) = True Then
Sub oder Funktion nicht definiert

AW: Excel-Daten in Outlook Kalender übermitteln
14.07.2008 19:07:00
Ramses
Hallo
Ich bin doch nicht dein Angestellter.
Gruss Rainer

AW: Excel-Daten in Outlook Kalender übermitteln
15.07.2008 19:04:59
Frank
Hallo Rainer,
tut mir leid, wenn ich ein Bisschen undankbar rüberkam.
Ich war in Zeitnot.
Trotzdem vielen Dank für deine Bemühungen.
Gruß Frank

307 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige