Kontakte aus Excel-Tabelle in Outlook importieren

  • VB.NET

    Kontakte aus Excel-Tabelle in Outlook importieren

    Hi,
    folgendes Problem: Ich habe ein Visual Basic Script erstellt, welches alle in Outlook gespeicherten Kontakte in eine Excel Tabelle schreibt.
    Der Export funktioniert prima und einwandfrei.
    Jedoch stellt sich der Import von der Excel nach Outlook etwas problematisch dar.
    Hat jemand einen Tipp oder sogar die Lösung warum der bisherige Code nicht funktioniert ?

    PS: Ich beschäftige mich noch nicht sehr lange mit Visual Basic, also verzeiht mir bitte solltet ihr blutige Anfängerfehler finden :)

    Hier nun der bisherige Code:

    VB.NET-Quellcode

    1. Imports Outlook = Microsoft.Office.Interop.Outlook
    2. Imports Excel = Microsoft.Office.Interop.Excel
    3. Public Class FExport
    5. Dim olApp As Microsoft.Office.Interop.Outlook.Application
    6. Dim olNameSpace As Microsoft.Office.Interop.Outlook.NameSpace
    7. Dim olContactsFolder As Microsoft.Office.Interop.Outlook.MAPIFolder
    8. Dim olAll As Microsoft.Office.Interop.Outlook.Items
    9. Dim olReal As Microsoft.Office.Interop.Outlook.Items
    10. Dim olContact As Microsoft.Office.Interop.Outlook.ContactItem
    11. Dim syncSuccess As Boolean
    12. Dim AllProcesses() As System.Diagnostics.Process = System.Diagnostics.Process.GetProcesses()
    13. Dim MyProcess As System.Diagnostics.Process
    14. Dim strContactFilter As String
    15. Dim xlApp As Object
    16. Dim xlWb As Object
    17. Dim xlWs As Object
    18. Dim intRow As Integer
    19. Dim Rows As Object
    20. Dim xlUp As Object
    22. Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BStart.Click
    24. If CAuswahl.Text = "Exportieren" Then
    26. 'Outlook-Objekte öffnen
    27. olApp = CreateObject("Outlook.Application")
    28. olNameSpace = olApp.GetNamespace("MAPI")
    29. olContactsFolder = olNameSpace.GetDefaultFolder(Microsoft.Office.Interop.Outlook.OlDefaultFolders.olFolderContacts)
    30. olAll = olContactsFolder.Items
    32. 'Verteilerlisten herausfiltern,
    33. 'nur 'Richtige Kontakte' verwenden
    34. strContactFilter = "[MessageClass] = 'IPM.Contact'"
    35. olReal = olAll.Restrict(strContactFilter)
    37. 'Excel-Objekte öffnen
    38. xlApp = CreateObject("Excel.Application") 'Neue Excel-Instanz
    39. xlWb = xlApp.Workbooks.Add 'Neues Workbook anlegen
    40. xlWs = xlWb.Sheets(1) 'Erstes Sheet
    42. 'Excel-Worksheet aufbereiten
    43. With xlWs
    45. 'Sheet-Name
    46. .Name = "Outlook-Kontakte"
    48. 'Spaltenüberschriften
    49. .cells(1, 1).Value = "Vorname"
    50. .cells(1, 2).Value = "Nachname"
    51. .cells(1, 3).Value = "E-Mail"
    52. .cells(1, 4).Value = "Strasse"
    53. .cells(1, 5).Value = "PLZ"
    54. .cells(1, 6).Value = "Ort"
    55. .cells(1, 7).Value = "Land"
    56. .cells(1, 8).Value = "Telefon"
    58. 'Spaltenüberschriften fett
    59. .Rows("1:1").Font.Bold = True
    61. 'Outlook-Kontakte nach Excel übertragen
    62. intRow = 2
    63. For Each itmContacts In olReal
    64. .cells(intRow, 1).Value = itmContacts.FirstName
    65. .cells(intRow, 2).Value = itmContacts.LastName
    66. .cells(intRow, 3).Value = itmContacts.Email1Address
    67. .cells(intRow, 4).Value = itmContacts.BusinessAddressStreet
    68. .cells(intRow, 5).Value = itmContacts.BusinessAddressPostalCode
    69. .cells(intRow, 6).Value = itmContacts.BusinessAddressCity
    70. .cells(intRow, 7).Value = itmContacts.BusinessAddressCountry
    71. .cells(intRow, 8).Value = itmContacts.BusinessTelephoneNumber
    72. intRow = intRow + 1
    73. Next itmContacts
    75. 'Optimale Spaltenbreite
    76. .Columns.AutoFit()
    78. syncSuccess = True
    80. CreateContacts_Exit:
    81. If syncSuccess = True Then
    82. MsgBox("Die Synchronisierung war erfolgreich", vbInformation)
    83. Me.Close()
    84. Else
    85. MsgBox("Die Synchronisierung ist fehlgeschlagen", vbInformation)
    86. End If
    88. End With
    90. 'Excel einblenden
    91. xlApp.Visible = True
    92. xlWb.SaveAs("C:\Kontakte\Kontakte " & DateString & ".xlsx")
    94. For Each Process In System.Diagnostics.Process.GetProcessesByName("excel")
    95. Process.Kill()
    96. Next
    98. 'Speicher freigeben
    99. olReal = Nothing
    100. olAll = Nothing
    101. olContactsFolder = Nothing
    102. olNameSpace = Nothing
    104. xlWs = Nothing
    105. xlWb = Nothing
    106. xlApp = Nothing
    108. ElseIf CAuswahl.Text = "Importieren" Then
    110. Dim olApp As Microsoft.Office.Interop.Outlook.Application
    111. Dim olNameSpace As Microsoft.Office.Interop.Outlook.NameSpace
    112. Dim olContactsFolder As Microsoft.Office.Interop.Outlook.MAPIFolder
    113. Dim olAll As Microsoft.Office.Interop.Outlook.Items
    114. Dim olReal As Microsoft.Office.Interop.Outlook.Items
    115. Dim olContact As Microsoft.Office.Interop.Outlook.ContactItem
    116. Dim AllProcesses() As System.Diagnostics.Process = System.Diagnostics.Process.GetProcesses()
    117. Dim MyProcess As System.Diagnostics.Process
    118. Dim xlApp As Microsoft.Office.Interop.Excel.Application
    119. Dim exWb As Microsoft.Office.Interop.Excel.Workbook
    120. Dim exWs As Microsoft.Office.Interop.Excel.Worksheet
    121. Dim intRow As Integer
    122. Dim lngLastRow As Long
    123. Dim lngContactsCount As Long
    124. Dim syncSuccess As Boolean
    125. Dim strContactFilter As String
    126. Dim aktzeile As Integer
    127. Dim zeilennr As Integer
    128. Dim inhalt As Object
    129. Dim FileName As String
    130. Dim ToRangeCounter As Object
    131. Dim xlUp As Long
    132. Dim xlToRight As Long
    133. Dim Contact As Object
    135. xlApp = CreateObject("Excel.Application")
    136. olApp = CreateObject("Outlook.Application")
    137. olNameSpace = olApp.GetNamespace("MAPI")
    138. olContactsFolder = olNameSpace.GetDefaultFolder(Microsoft.Office.Interop.Outlook.OlDefaultFolders.olFolderContacts)
    140. With xlApp
    141. xlApp.Visible = True
    142. xlWb = xlApp.Workbooks.Open("C:\Kontakte\Kontakte " & DateString & ".xlsx")
    144. End With
    146. olContact = olApp.CreateItem(Outlook.OlItemType.olDistributionListItem)
    148. intRow = 0
    149. For Each itmContacts In olReal
    150. itmContacts.FirstName = xlWs.cells(intRow, 1).Value
    151. itmContacts.LastName = xlWs.cells(intRow, 2).Value
    152. itmContacts.Email1Address = xlWs.cells(intRow, 3).Value
    153. itmContacts.BusinessAddressStreet = xlWs.cells(intRow, 4).Value
    154. itmContacts.BusinessAddressPostalCode = xlWs.cells(intRow, 5).Value
    155. itmContacts.BusinessAddressCity = xlWs.cells(intRow, 6).Value
    156. itmContacts.BusinessAddressCountry = xlWs.cells(intRow, 7).Value
    157. itmContacts.BusinessTelephoneNumber = xlWs.cells(intRow, 8).Value
    158. intRow = intRow + 1
    160. itmContacts.Save()
    161. Next
    163. ' .ActiveWorkbook.Save
    164. ' .ActiveWorkbook.Close
    165. ' .Quit
    167. End If
    168. End Sub
    170. Private Sub BExit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BExit.Click
    171. Me.Close()
    172. End Sub
    174. End Class


    *Topic verschoben, das ist kein VBScript*

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Marcus Gräfe“ ()