Ich habe ein Problem mit outlook. Ich möchte in meiner Firma die outlook Kontakte mit mehreren Personen gemeinsam verwalten (ohne Exchange Server) Ist das möglich?
Als Ausweichlösung könnte ich mir vorstellen, daß die Sekretärin die Kontakte einmal eingibt und alle Mitarbeiter sie täglich in Ihre pst-Datei übernehmen. Ich habe im Archiv einen Beitrag von Herrn
W o l f g a n g P u s c h a c h e r Datum: 7.3.2002 14:50 Uhr
gefunden. Dort wird beschrieben, wie man das Problem per Makro mit den Terminen lösen kann. Export in eine Datei und von dort zurück auf anderen PC.
Hier die Lösung für Termine:
Sub AlleTermineExportieren()
Dim olApp As Outlook.Application
Dim olNameSpace As Outlook.NameSpace
Dim olCalendar As Outlook.MAPIFolder
Dim olAppointment As Outlook.AppointmentItem
Dim s As String
Dim d As Date
Dim t As Date
Dim ts As String
Open „a:\termine.txt“ For Output As #1
Dim n As Integer
Set olApp = CreateObject(„Outlook.Application“) 'oder New Outlook.Application
Set olNameSpace = olApp.GetNamespace(„MAPI“)
Set olCalendar = olNameSpace.GetDefaultFolder(olFolderCalendar)
n = 0
For Each olAppointment In olCalendar.Items
s = olAppointment.Subject
If s = „“ Then s = „-“
d = Fix(olAppointment.Start)
t = CDate(olAppointment.Start - d)
If t = 0 Then
ts = „“
Else
ts = " (" & CStr(t) & „)“
End If 't=0
Debug.Print Fix(d) & s & ts
Write #1, olAppointment, olAppointment.Start, olAppointment.End, olAppointment.Body
n = n + 1
Next 'olAppointment
Set olAppointment = Nothing
Set olCalendar = Nothing
Set olNameSpace = Nothing
Set olApp = Nothing
Close #1
MsgBox „Insgesamt " & n & " Einträge exportiert“, vbInformation, „Fertig“
End Sub 'AlleTermineExportieren
Sub AlleTermineImportieren()
Call Termine_vorlöschen
Dim olApp As Outlook.Application
Dim olNameSpace As Outlook.NameSpace
Dim olCalendar As Outlook.MAPIFolder
Dim olAppointment As Outlook.AppointmentItem
Dim s As String
Open „a:\termine.txt“ For Input As #1
Dim n As Integer
Dim Termin, Start, Ende, Body
n = 0
Do While Not EOF(1) ’ Schleife bis Dateiende.
n = n + 1
Set myOlApp = CreateObject(„Outlook.Application“)
Set myItem = myOlApp.CreateItem(olAppointmentItem)
Input #1, Termin, Start, Ende, Body ’ Daten in Variablen einlesen.
Debug.Print Termin, Start, Ende, Body ’ Daten im Direktfenster ausgeben.
s = Termin
myItem.Subject = s
myItem.Start = Start
myItem.End = Ende
myItem.Body = Body
myItem.Save
Loop
Close #1
Set olAppointment = Nothing
Set olCalendar = Nothing
Set olNameSpace = Nothing
Set olApp = Nothing
Close #1
MsgBox „Insgesamt " & n & " Einträge importiert“, vbInformation, „Fertig“
End Sub 'AlleTermineImportieren
Sub Termine_vorlöschen()
Dim olApp As Outlook.Application
Dim olNameSpace As Outlook.NameSpace
Dim olCalendar As Outlook.MAPIFolder
Dim olAppointment As Outlook.AppointmentItem
Dim s As String
Dim d As Date
Dim t As Date
Dim ts As String
Dim n As Integer
Set olApp = CreateObject(„Outlook.Application“) 'oder New Outlook.Application
Set olNameSpace = olApp.GetNamespace(„MAPI“)
Set olCalendar = olNameSpace.GetDefaultFolder(olFolderCalendar)
n = 0
For Each olAppointment In olCalendar.Items
n = n + 1
olAppointment.Delete
Next 'olAppointment
Set olAppointment = Nothing
Set olCalendar = Nothing
Set olNameSpace = Nothing
Set olApp = Nothing
End Sub
Da ich leider nicht so gut mit VBA umgehen kann, noch mal meine Fragen:
-
Ist es möglich, obere Makros anzupassen, um die Termine zusammenzuführen und nicht zu überschreiben?
-
Wie muß das Makro für die Kontakte aussehen?
Bin für jede Hilfe dankbar
Jürgen