Hi bin wieder mal lästig ::)
ich würde gerne in meine Access DB alle Termine von Outlook 2010 nach Access 2010 in eine Tabelle einfügen.
Ich habe es momentan mit einer einfachen Verknüpfung erledigt nur kann ich die Termine nur bis den Heutigen Datum sehen bzw. werden nur Termine bis zum Heutigen Datum in die Tabelle eingefügt.
Da ich aber mehrere Serien Termine habe möchte ich auch diese zur weiteren Verarbeitung in Access haben also auch zukünftige Termine.
Habe auch verschiede Codes für VBA probiert aber leider konnte ich diese nicht verwenden da ich immer Fehlermeldungen bekommen habe :(
Vielleicht könnte mir diesbezüglich jemand helfen?
Vielen Dank
Silentwolf :)
Hallo,
da sollte es aber genügend Lösungen im Netz geben.
Schau mal hier: http://www.access-im-unternehmen.de/index1.php?id=300&BeitragID=828
der wesentliche Codeblock wird dort veröffentlicht.
Leider doch nicht, sorry.
Gruß Andreas
Zusatz...
Hier habe ich den Code den ich Probiert habe...den ich aus einen Buch habe.
Public Function ImportApptsFromOutlook()
On Error GoTo ErrorHandler
Dim objNameSpace As NameSpace
Dim fldCalendar As Outlook.Folder
Dim appt As Outlook.AppointmentItem
Dim strApptName As String
Dim dteStartTime As Date
Dim dteEndTime As Date
Dim strLocation As String
Dim strSQL As String
Dim strDescription As String
Dim appOutlook As Application
Set appOutlook = GetObject(, "Outlook.appointment")
Set nms = appOutlook.GetNamespace("MAPI")
Set fldCalendar = nms.GetDefaultFolder(olFolderCalender)
clear table of old data
strSQL = "DELETE *From tblImportedCalendar"
DoCmd.SetWarnings False
DoCmd.RunSQL
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tblImportedCalendar")
Iterate through the apointments in the local Calendar folder and import them to the Access table
For Each itm In fldCalendar.Items
If itm.Class = olAppointment Then
Set appt = itm
With appt
strApptName = Nz(.Subject)
dteStartTime = Nz(.Start)
dteEndTime = Nz(.End)
strLocation = Nz(.Location)
strDescription = Nz(.Body)
End With
With rst
rst.AddNew
![Subject] = strApptName
If dteStartTime <> #1/1/4501# Then
![Start Time] = dteStartTime
End If
If dteEndTime <> #1/1/4105# Then
![End Time] = dteEndTime
End If
![Location] = strLocation
![Description] = strDescription
.Update
End With
End If
Next itm
rst.Close
DoCmd.OpenTable "tblImportedCaledar"
ErrorhandlerExit:
Exit Function
ErrorHandler:
Outlook is not running; Outlook with Create Object
If Err.Number = 429 Then
Set .appOutlook = CreateObject("Outlook.application")
resum.Next
Else
MsgBox "Error No: " & Err.Number _
& "; Description: " & Err.Description
Resume ErrorhandlerExit
End If
End Function
der Code hält das erste mal schon bei GetNamespace
wo liegt hier das Problem kann wüste das jemand?
Glg
SW
Hi Hondo,
danke für Deine Antwort! Ja ich habe diesen Beitrag selbst auch schon gesehen aber da ist ja Code nicht komplette oder? Bei der Function fehlt doch noch einiges..?? Oder??
Lg
Hallo,
also dein Code ist total fehlerhaft. Calender statt Calendar etc.
Anbei der korrigierte Code - als early Binding also Verweiss auf Microsoft Outlook X.X Object Library setzten oder wieder umändern auf lateBinding.
Public Function ImportApptsFromOutlook()
On Error GoTo ErrorHandler
Dim objNameSpace As NameSpace
Dim fldCalendar As Outlook.Folder
Dim appt As Outlook.AppointmentItem
Dim strApptName As String
Dim dteStartTime As Date
Dim dteEndTime As Date
Dim strLocation As String
Dim strSQL As String
Dim strDescription As String
Dim appOutlook As Outlook.Application
Set appOutlook = New Outlook.Application
Set nms = appOutlook.GetNamespace("MAPI")
Set fldCalendar = nms.GetDefaultFolder(olFolderCalendar)
'clear table of old data
strSQL = "DELETE *From tblImportedCalendar"
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tblImportedCalendar")
'Iterate through the apointments in the local Calendar folder and import them to the Access table
For Each itm In fldCalendar.Items
If itm.Class = olAppointment Then
Set appt = itm
With appt
strApptName = Nz(.Subject)
dteStartTime = Nz(.Start)
dteEndTime = Nz(.End)
strLocation = Nz(.Location)
strDescription = Nz(.Body)
End With
With rst
rst.AddNew
![Subject] = strApptName
If dteStartTime <> #1/1/4501# Then
![Start Time] = dteStartTime
End If
If dteEndTime <> #1/1/4105# Then
![End Time] = dteEndTime
End If
![Location] = strLocation
![Description] = strDescription
.Update
End With
End If
Next itm
rst.Close
DoCmd.OpenTable "tblImportedCaledar"
ErrorhandlerExit:
Exit Function
ErrorHandler:
MsgBox "Error No: " & Err.Number _
& "; Description: " & Err.Description
Resume ErrorhandlerExit
End Function
Danke Hondo!!
hab Ihn grad kompiliert.
Es hat leider noch einen Fehler.
Die Variable nms ist nicht definiert.
Wie muss ich diese den definieren?
dim nms as "Welcher Datentyp"?
Danke.
Na ein bisschen Mitdenken hätte nicht geschadet ;-)
Dim nms As Outlook.NameSpace
Hi Hondo,
ja Dankeschön :) Hast eh recht nur bin ich trotz allem noch nicht so ganz sicher mit VBA und daher noch etwas ängstlich ;D,
Diese habe ich noch dazu gefügt.
Dim dbs As Database
Dim rst As Recordset
Dim itm As Items
sollten so stimmen oder?
Habs zumindest so gemacht :)
Nun habe ich die Function ausgeführt und bekomme schon wieder einen Fehler dieses mal die msgbox Describtion Type unverträglich..
Muss ich dann nochmals ansehen hoffe ich kann es lösen.
Im Formular ist es ein Textfeld
Schöne Grüße und nochmals vielen Dank!
Hallo nochmal,
hab jetzt nochmal den Code durchgeschaut weis aber nicht woran es liegt das ich diese Fehlermeldung bekomme.
Error No:13 Description: Typen unverträglich.
Muss ich hier meine Tabelle ändern??
Danke für Eure Hilfe!!
SW
Hallo,
ja wird ganz sicher an deiner Tabellenstruktur liegen.
Schreibe doch mal wie die Tabelle aufgebaut ist.
Hallo,
ja dachte ich mir..
ID
das ist wohl etwas zu schnell gegangen :(
Also nochmal
ID .........AutoWert
Subject........Text
Start Time.......Datum/Uhrzeit
End Time.........Datum/Uhrzeit
Location...........Text
Description...........Text
Dankeschön
Hallo,
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim itm As Object
Hallo,
danke Franz das hat mal den Fehler behoben :)
Jetzt kommt aber schon wieder eine neue :( Error No: 2046: Description: Der Befehl oder die Aktion 'Ausführen SQL' ist zurzeit
nicht verfügbar...
Habe leider keine Ahnung warum oder was es bedeutet.
Schöne Grüße
SW
Hi,
ist die Tabelle "tblImportedCalendar" irgendwo geöffnet?
Zudem fehlt ein Leerzeichen nach dem Sternchen...
Hi,
hab nun die Tabelle geschlossen und ja es funktioniert soweit. Danke :)
Nur wie kann es sein das nun nicht alle Termine in die Tabelle eingefügt werden ... :(
Wieder nur einige von früher und keine bis zum Heutigen Tag oder nachher.
Hmm
Schöne Grüße
Korrigiere zunächst überall die Tabellennamen..
Serientermine werden nicht berücksichtigt.
Hi,
Du meinst im Code?? Die Tabellen Namen korrigieren?
Oder wo meinst?
Serientermine werden nicht berücksichtig ...
Das ist dann gar nicht gut :(
Wollte eigentlich eine Art Prognose erstellen also welche Aufträge zur welcher Zeit kommen und eben diese danach weiter bearbeiten in Access.
Also sprich in Outlook Termine festlegen diese nach Access oder in eine Access Tabelle einfügen und dann weiterbearbeiten um Zeitplan und Kosten und Einnahmen zu berechnen.
Also kann ich das mit dieser Variante nicht erledigen..
Oder?
Schönen Gruß und Danke für einen Input :)
Hi,,
ja im Code:
DoCmd.OpenTable "tblImportedCaledar"
(aus Beitrag #5)
Ich weiß ja nicht, welche Art von Kalendereinträgen (Termine) nun genau gemacht werden... und ob solche Termine überhaupt diese Art von Prognosen/Berechnungen erlauben...
Hi,
hab es schon geändert die Namen :)
Na ich habe einige Termine die ich wöchentlich, täglich oder halbjährlich oder Monatlich erledigen muss. oder darf ;)
Nun möchte ich gerne eine Prognoserechnung machen wie welche Kosten entstehen oder wie viel ich eben verlange für die Arbeit.
Da es natürlich einfacher in Outlook eingetragen wird möchte ich diese dort verwalten aber eben in Access weiter pflegen sozusagen.
Vielleicht hat jemand so eine ähnliche Situation schon gehabt oder erstellt und könnte mich auf den Richtigen Weg bringen :)
Schöne Grüße
SW