none
Outlook Kalender

    Frage

  • Hallo Ihr Lieben,

    ich habe da ein Problem mit meinem Programm...Es wurde hier eine Datenbank in Access entwickelt die einwandfrei funktioniert bis auf eine Funktion...Per Klick soll eine Termineinladung in Outlook erzeugt werden...welches Ebenfalls funktioniert...das einzige Problem hier ist, dass er bei der automatischen Generierung immer aus meinem persönlichen Emailkonto die Termineinladung schickt...Ich möchte jedoch die Einladung aus meinem zweiten Emailkonto aus verschicken...

    Ich habe versucht die Variable

    outCalendar zu aktivieveren...jedoch ohne Erfolg

    .SendUsingAccount habe ich ebenfalls versucht welches zu keinem Ergebnis geführt hat...

    zu guter letzt habe ich mir in Outlook die Kontoeinstellungen angeschaut und bin zum Ergebnis gekommen, dass mein persönlicher Emailkonto auf Standard gesetzt ist. Ich habe versucht den zweiten auf Standard zu setzen, welches mir dann die Einladung wie gewollt vom zweiten aus schickt. Das Problem ist jedoch, dass mein persönl. Emailkonto auf Standard bleiben muss.

    Gibt es also irgendeine Möglichkeit die Einladung aus dem zweiten Emailkonto zu verschicken(auch wenn das persönl. Konto auf Standard gesetzt ist)?

    If Me.statusNr = 10 And Me.IsDone = True Then
    question1 = MsgBox("Möchten Sie eine Email für die Termineinladung verschicken?", vbYesNo)
        If (question1 = vbYes) Then
            question2 = MsgBox("Möchten Sie die Anmeldungsseite der Schulung öffnen?", vbYesNo)
                If (question2 = vbYes) Then
                    Call mdlFunctionEmail.site
                ElseIf (question2 = vbNo) Then
                End If
    
    
    Dim aOutl As Outlook.Application
    Dim rsMail As DAO.Recordset
    Dim AppointOutl As Outlook.AppointmentItem
    Dim myRequiredAttendee As Outlook.Recipient
    Dim outCalendar As Outlook.MAPIFolder
    Dim rsTrainer As DAO.Recordset2
    
    
    Set aOutl = CreateObject("Outlook.Application")
    Set AppointOutl = aOutl.CreateItem(olAppointmentItem)
    Set outCalendar = aOutl.GetNamespace("MAPI").Folders("FIRMA").Folders("Kalender")
    Set aOutl.ActiveExplorer.CurrentFolder = outCalendar
    
    Set rsMail = CurrentDb.OpenRecordset("qryTeilnehmer")
    Set rsTrainer = CurrentDb.OpenRecordset("qryPersonsAndRoleTraining")
    
        Date1 = InputBox("Bitte Startdatum der Schulung eingeben", , "01.10.2013")
        Date2 = InputBox("Bitte Enddatum der Schulung eingeben", , "02.10.2013")
        Time1 = InputBox("Bitte Startzeit der Schulung eingeben", , "09:00")
        Time2 = InputBox("Bitte Endzeit der Schulung eingeben", , "18:00")
        Location = InputBox("Bitte Ort der Schulung eingeben", , "München ")
    
    Open "PFAD" For Input As #1
    
        Do While Not EOF(1)
            Line Input #1, textzeile
            s = s & Chr(13) & textzeile
        Loop
    
    With rsMail
        Do Until .EOF
           
            strMail = strMail & ";" & .Fields("E-Mail")
            .MoveNext
        Loop
            
            
            AppointOutl.MeetingStatus = olMeeting
            AppointOutl.Subject = " Test" 
            AppointOutl.Location = Location
            AppointOutl.Start = CDate(Date1) + CDate(Time1)
            AppointOutl.End = CDate(Date2) + CDate(Time2)
            AppointOutl.ReminderSet = True
            AppointOutl.ReminderMinutesBeforeStart = 2880
            AppointOutl.ResponseRequested = True
            Set myRequiredAttendee = AppointOutl.Recipients.Add(strMail)
            myRequiredAttendee.Type = olRequired
    End With
            rsMail.Close
            Set rsMail = Nothing
      
        Close #1
        
    
    With rsTrainer
        Do Until .EOF
            strTrainer = strTrainer & ";" & .Fields("E-Mail")
            strName = strName & .Fields("FirstName")
            .MoveNext
        Loop
             AppointOutl.Body = "Test”
            Set myOptionalAttendee = AppointOutl.Recipients.Add(strTrainer)
            myOptionalAttendee.Type = olOptional
            
            AppointOutl.Display
       
    End With
        rsTrainer.Close
        
            Set rsTrainer = Nothing
            Set AppointOutl = Nothing
        
        Close #1
        
            Set outl = Nothing
        
    Else
            Me.Undo
            Form_Current
        End If
    End If
    

    Dienstag, 11. Februar 2014 20:33