Kontakte in Outlook

  • VB6

Es gibt 1 Antwort in diesem Thema. Der letzte Beitrag () ist von Sinlyu.

    Kontakte in Outlook

    [font='&quot']Hallo zusammen,

    ich bin ein Einsteiger in VB6 und hätte da gerne ein paar Gedankenanregungen oder auch Tipps :)

    Ich versuche über VB6 in Outlook neue Kontaktgruppen + Unterordner zu erstellen und nebenbei ein Kontakt zu suchen und diesen zu löschen.



    Die Form:

    Quellcode

    1. Private Sub Command1_Click()
    2. Module1.Init
    3. Module1.OpenFolderOrCreate "Postfach - Nachname, Vorname\Kontakte\NeueListe\NeueUnterListe" ' Hier sollen die Ordner/Unterordner erstellt werden, sofern nicht vorhanden!
    4. Module1.OpenFolderOrCreate "Postfach - Nachname, Vorname\Kontakte\Klient" ' Dieser Ordner soll geöffnet bzw. erstellt werden.
    5. Module1.FindItemOrNew "T- Commander Troi Deanna" ' Dieser Kontakt soll gefunden und ersetzt werden durch:
    6. Module1.Attrib "Name", "T- Lieutenant" ' die neuen Attribute des Kontaktes
    7. Module1.Attrib "Vorname", "Worf"
    8. Module1.Attrib "Anrede", "Prof.Dr.Lit.Med.Dent."
    9. Module1.Save
    10. Module1.FindAndDeleteItem "T- Lieutenant Yar Natasha" ' und hier hapert es: er löscht diese Kontaktperson nicht!
    11. Module1.Quit
    12. End Sub


    Hier das Modul:

    Quellcode

    1. Private olNs As Outlook.NameSpace
    2. Private olApp
    3. Private Folder As Folder
    4. Private Item
    9. ' --- startet outlook
    10. Public Sub Init()
    11. Set olApp = Outlook.Application
    12. End Sub
    14. ' --- anmelden bei outlook
    15. Public Sub Logon()
    16. Set olNs = olApp.GetNamespace("MAPI")
    17. olNs.Logon
    18. End Sub
    20. ' --- sucht einen Pfad und speichert in Folder
    21. Public Sub OpenFolderOrCreate(Path As String)
    22. FindFolderOrCreate Outlook.Session.Folders, Path
    23. MsgBox Folder.name
    24. End Sub
    26. Private Sub FindFolderOrCreate(Folders As Folders, Path As String)
    27. Dim index As Integer
    28. Dim found As Boolean
    29. Dim aFolder As Folder
    30. found = False
    31. For index = 1 To Folders.Count
    32. Set aFolder = Folders.Item(index)
    33. If InStr(1, Path, aFolder.name) = 1 Then
    34. found = True
    35. If InStr(1, Path, "\") > 0 Then
    36. Path = Replace(Path, aFolder.name & "\", "")
    37. Set Folder = aFolder
    38. FindFolderOrCreate aFolder.Folders, Path
    39. Else
    40. Set Folder = aFolder
    41. End If
    42. Exit For
    43. End If
    44. Next
    45. If found = False Then
    46. Dim i As Integer
    47. i = InStr(1, Path, "\")
    48. Dim name As String
    49. If i = 0 Then
    50. name = Path
    51. Else
    52. name = Left(Path, InStr(1, Path, "\") - 1)
    53. End If
    54. Set aFolder = Folder.Folders.Add(name)
    55. If InStr(1, Path, "\") > 0 Then
    56. Path = Replace(Path, aFolder.name & "\", "")
    57. Set Folder = aFolder
    58. FindFolderOrCreate aFolder.Folders, Path
    59. Else
    60. Set Folder = aFolder
    61. End If
    62. End If


    Quellcode

    1. Private Function FindItem(name As String) As Boolean
    2. Dim found As Boolean
    3. found = False
    4. Dim objItems As Items
    5. Set objItems = Folder.Items
    6. For index = 1 To objItems.Count
    7. Dim objItem As ContactItem
    8. Set objItem = objItems.Item(index)
    9. If objItem.LastName = name Then
    10. Set Item = objItem
    11. found = True
    12. Exit For
    13. End If
    14. Next
    15. FindItem = found
    16. End Function



    Quellcode

    1. Public Sub FindAndDeleteItem(name As String)
    2. Dim found As Boolean
    3. found = FindItem(name)
    4. If found = True Then
    5. Item.Delete
    6. End If
    7. End Sub


    Klappt auch alles bis zum 3. Codefenster super!
    Jedoch wird nicht wie gewollt die Person im 3. Codefenster gelöscht. Er findet sie zwar, löscht sie allerdings nicht!


    Wäre Euch für Hilfe sehr dankbar.
    Da dies mein erster Forenbeitrag ist, erhängt mich bitte nicht, falls die Anordnung meiner Fenster etc. nicht forumsstandard ist.

    Vielen Dank schon mal! :)

    Lg, Marius
    [/font]

Facebook
Telefonspende