|
| |
Fortgeschrittene Programmierung| Re: Outlook Termin mit VB6 setzten und auslesen | |  | | Autor: smither | | Datum: 09.02.04 18:15 |
| hi thomas,
habe mal in meinen alten codes rumgestöbert und noch ein kleines beispiel gefunden das dir vielleicht weiterhilft - allerdings thema email. aber ich denke das das bei appointments nicht anders läuft. keine ahnung wie gut oder schlecht der code ist, ist schon ein bisserl her  .
Sub GetMails()
On Error Resume Next
Dim objInboxItems As Items
lvMailItems.ListItems.Clear
Set objInboxItems = oOtl.NameSpace.GetDefaultFolder(olFolderInbox).Items
SearchFolders oOtl.NameSpace.GetDefaultFolder(olFolderInbox), 1
' sEmail = txtEmail.Text
' sCriteria = "[SenderName] =""" & sEmail & """ "
' Set oItem = objInboxItems.Find(sCriteria)
' If sEmail <> "" Then
' Do While Not (oItem Is Nothing)
' Set li = lvMailItems.ListItems.Add(, , oItem.SenderName, , 1)
' li.ListSubItems.Add , , oItem.Subject
' li.ListSubItems.Add , , Format(oItem.CreationTime, "DD.MM.YYYY")
' li.Tag = oItem.EntryID
' Set oItem = objInboxItems.FindNext 'Find the next
' Loop
' End If
' Set oItem = Nothing
' Set objInboxItems = Nothing
End Sub
Private Sub SearchFolders(ByVal fld As Outlook.MAPIFolder, iLevel As Integer)
On Error GoTo Err_Trap
Dim i As Integer
Dim fldr1 As Outlook.MAPIFolder
Dim oItem As Outlook.MailItem
Dim objInboxItems As Items
Dim sEmail As String
Dim sCriteria As String
Dim li As ListItem
sEmail = txtEMail.Text
If fld.Folders.Count > 0 Then
Do Until i = fld.Folders.Count
i = i + 1
Set fldr1 = fld.Folders(i)
Set objInboxItems = fld.Items
sCriteria = "[SenderName] =""" & sEmail & """ "
Set oItem = objInboxItems.Find(sCriteria)
If sEmail <> "" Then
Do While Not (oItem Is Nothing)
Set li = lvMailItems.ListItems.Add(, , oItem.SenderName, , 1)
li.ListSubItems.Add , , oItem.Subject
li.ListSubItems.Add , , Format(oItem.CreationTime, "DD.MM.YYYY")
li.Tag = oItem.EntryID
Set oItem = objInboxItems.FindNext 'Find the next
Loop
End If
'Suche in Subfolders
If fldr1.Folders.Count > 0 Then
SearchFolders fldr1, iLevel + 1
End If
Loop
Else
Set objInboxItems = fld.Items
sCriteria = "[SenderName] =""" & sEmail & """ "
Set oItem = objInboxItems.Find(sCriteria)
If sEmail <> "" Then
Do While Not (oItem Is Nothing)
Set li = lvMailItems.ListItems.Add(, , oItem.SenderName, , 1)
li.ListSubItems.Add , , oItem.Subject
li.ListSubItems.Add , , Format(oItem.CreationTime, "DD.MM.YYYY")
li.Tag = oItem.EntryID
Set oItem = objInboxItems.FindNext 'Find the next
Loop
End If
End If
Set oItem = Nothing
Set objInboxItems = Nothing
Exit Sub
Err_Trap:
HandleError Err, "frmContact", "SearchFolders"
End Sub | |
 | Sie sind nicht angemeldet!
Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden.
 Einloggen | Neu registrieren |
 |
|
sevOutBar 4.0 
Vertikale Menüleisten
á la Outlook
Erstellen von Outlook ähnlichen Benutzer- interfaces - mit beliebig vielen Gruppen und Symboleinträgen. Moderner OfficeXP-Style mit Farbverläufen, Balloon-Tips, u.v.m. Weitere InfosTipp des Monats  Oktober 2025
Matthias KozlowskiUmlaute konvertierenErsetzt die Umlaute in einer Zeichenkette durch die entsprechenden Doppelbuchstaben (aus ä wird ae, usw.) TOP Entwickler-Paket 
TOP-Preis!!
Mit der Developer CD erhalten Sie insgesamt 24 Entwickler- komponenten und Windows-DLLs. Die Einzelkomponenten haben einen Gesamtwert von 1866.50 EUR...
Jetzt nur 979,00 EURWeitere Infos
|
| |
|
Copyright ©2000-2025 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.
Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel
|
|
Sie sind aktuell nicht angemeldet.
