Objektverbindung trennen

  • VB.NET

Es gibt 19 Antworten in diesem Thema. Der letzte Beitrag () ist von lris08.

    Objektverbindung trennen

    Hallo,

    benötige mal eure Hilfe... komm da nicht weiter...


    Verbinde mein Programm mit Outlook, hole mir über DragDrop ein Kontakte in mein Programm - funktioniert soweit.

    Jedoch habe ich das Problem, dass die Verbindung mit Outlook nach der Übernahme meines Kontaktes nicht geschlossen wird.

    So öffne ich die Verbindung:

    VB.NET-Quellcode

    1. Imports Outlook = Microsoft.Office.Interop.Outlook
    2. ...
    4. Private Sub DragDrop__Personen_Funtkion_2(ByVal e As System.Windows.Forms.DragEventArgs, ByVal REF_Fa As Double)
    5. Dim myobj As Object
    6. ...
    7. If e.Data.GetDataPresent("FileGroupDescriptor") Then
    8. For i As Integer = 1 To objOL.ActiveExplorer.Selection.Count
    9. myobj = objOL.ActiveExplorer.Selection.Item(i)
    10. 'MsgBox(myobj.LastName & " " & myobj.FirstName & " " & myobj.CompanyName)
    11. Dim Geburtstag As String = myobj.Birthday
    12. .....
    13. End If
    14. myobj = Nothing


    myobj = Nothing scheint nicht auszureichen...

    Könnt Ihr mir vielleicht sagen wie ich die Verbindung schließe bzw. wo ich was darüber finden könnte ?
    Oder nen Anhaltspunkt nach was für Infos ich suchen könnte...

    Lg lris

    Hi, danke für die schnelle Antwort...

    das gibts gleich als Fehlermeldung:

    Für den Parameter "o" von "Public Shared Function ReleaseComObject(o As Object) As Integer"


    oder habe ich den falsch eingefügt `?


    VB.NET-Quellcode

    1. End Try
    2. Next
    3. End If
    4. System.Runtime.InteropServices.Marshal.ReleaseComObject
    5. con.Close()
    6. Schlussarbeiten()
    7. Datensaetze_laden()
    8. End Sub



    EDIT:

    Könnte es sein, dass ich nur irgendwie das hier leeren muß, bevor ich einen neuen markiere...

    VB.NET-Quellcode

    1. objOL.ActiveExplorer.Selection.Item(i)

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „lris08“ ()

    ok...

    also so...

    VB.NET-Quellcode

    1. System.Runtime.InteropServices.Marshal.ReleaseComObject(objOL)


    hat nur leider keinen Erfolg gebracht


    Muß ich den die Verbindung wirklich trennen, erreichen will ich eigentlich folgendes...

    Wenn ich in Outlook Kontakte einen Kontakt makiere, ihn dann in mein Form ziehe - soll er übernommen werden. Der erste Kontakt den ich rüberziehe per DragDrop funktioniert, aber wenn ich einen weiteren markiere und rüberziehe wird immer noch der erste verwendet...
    Und was ich gerade entdeckt habe, wenn ich den zweiten Kontakt öffnen will in Outlook bekomme ich die Fehlermdeldung... siehe Bild.
    Dann makiert er die Ganze Gruppe (Kategorie in Outlook) auf einmal...

    Daher kam auch meine Frage vorhin unter EDIT, ob ich nicht einfach (nur wie?) das select leeren muß ??

    VB.NET-Quellcode

    1. objOL.ActiveExplorer.Selection.Item(i)


    Lg lris
    Bilder

    • Gruppe.jpg

      27,21 kB, 298×180, 126 mal angesehen

    Also ich habe mich vor ein paar Tage auch mit der Outlook Kommunikation beschäftigt. Wenn du den nächsten Kontakt haben möchtest, musst du über Item den nächsten Eintrag holen. Bei Item musst du dann auch den Index erhöhen, aber Achtung bei Outlook wird bei 1 angefangen zu zählen. Das Kontakte Objekt holst du über ".GetNamespace("MAPI").GetDefaultFolder(10)"

    ok... jetzt blick ich nicht mehr durch...

    so versuche ich den Kontakt zu übernehmen... Wie gesagt, dass funktioniet immer nur beim ersten makieren des Kontaktes, wird ein weiterer markiert und zu übernehmen versucht, wird immer noch der erte verwendet - und wenn ich einen Kontakt in Outlook öffen will kommt die Fehlermeldung... wie unten das Bild...

    VB.NET-Quellcode

    1. Private Sub DragDrop__Personen_Funtkion(ByVal sender As Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles DGV_Personen.DragDrop
    2. Dim myobj As Object
    3. Dim REF_Fa As Double
    4. Dim Result1 As DialogResult
    5. Dim Result2 As DialogResult
    6. Result1 = MessageBox.Show("Soll der neue Kontakt der oben ausgewählten Firma zugeordnet werden ?" & vbCrLf & vbCrLf & _
    7. "Wenn nein wird Kontakt ohne Firmenzugehörigkeit angelegt !", " DIMS Info...", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button2)
    8. If Result1 = DialogResult.Yes Then
    9. REF_Fa = CDbl(DGV_Kundenliste.Rows(DGV_Kundenliste.CurrentRow.Index).Cells(0).Value)
    10. DragDrop__Personen_Funtkion_2(e, REF_Fa, 1)
    11. Else
    12. REF_Fa = 0
    13. Dim Ref_Firma_Name As String = Nothing
    14. Dim con1 As New OleDb.OleDbConnection
    15. Dim cmd1 As New OleDb.OleDbCommand
    16. Dim reader1 As OleDb.OleDbDataReader
    17. con1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source =" & Form1.Archiv_aktiv & "; Jet OLEDB:database Password=" & DBPass & ";"
    18. cmd1.Connection = con1
    19. If e.Data.GetDataPresent("FileGroupDescriptor") Then
    20. For i As Integer = 1 To objOL.ActiveExplorer.Selection.Count
    21. myobj = objOL.ActiveExplorer.Selection.Item(i)
    22. Try
    23. cmd1.CommandText = "SELECT * FROM WW_Firmen WHERE FA_Name1 LIKE '%" & myobj.CompanyName & "%'"
    24. con1.Open()
    25. reader1 = cmd1.ExecuteReader()
    26. Do While reader1.Read()
    27. REF_Fa = CDbl(reader1("ID"))
    28. Ref_Firma_Name = reader1("FA_Name1").ToString
    29. Loop
    30. con1.Close()
    31. Catch ex As Exception
    32. MessageBox.Show(ex.Message & vbCrLf & "Fehler DragDrop Personen - Zeile 633")
    33. con1.Close()
    34. End Try
    35. If REF_Fa = 0 Then
    36. MessageBox.Show("Keine Firma passende Firma gefunden" & vbCrLf & "Person kann nicht angelegt werden...", "DIMS Info", MessageBoxButtons.OK, MessageBoxIcon.Error)
    37. Exit Sub
    38. Else
    39. Result2 = MessageBox.Show("Es wurde eine passende Firma gefunden... " & vbCrLf & vbCrLf & _
    40. "Firma: " & Ref_Firma_Name & vbCrLf & vbCrLf & _
    41. "Soll die Person dieser Firma zugeordnet werden ?", "DIMS Info...", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1)
    42. If Result2 = DialogResult.Yes Then
    43. DragDrop__Personen_Funtkion_2(e, REF_Fa, i)
    44. Else
    45. MessageBox.Show("Abbruch, keine passende Firma gefunden...", "DIMS Info...", MessageBoxButtons.OK, MessageBoxIcon.Information)
    46. Exit Sub
    47. End If
    48. End If
    49. Next
    50. objOL.ActiveExplorer.ClearSelection()
    51. End If
    52. End If
    53. End Sub
    55. Private Sub DragDrop__Personen_Funtkion_2(ByVal e As System.Windows.Forms.DragEventArgs, ByVal REF_Fa As Double, ByVal Makiert As Integer)
    56. Dim myobj As Object
    57. Dim con As New OleDb.OleDbConnection
    58. Dim cmd As New OleDb.OleDbCommand
    59. con.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & Form1.Archiv_aktiv & "; Jet OLEDB:database Password=" & DBPass & ";"
    60. con.Open()
    61. cmd.Connection = con
    62. If e.Data.GetDataPresent("FileGroupDescriptor") Then
    63. myobj = objOL.ActiveExplorer.Selection.Item(Makiert)
    64. Dim Geburtstag As String = myobj.Birthday
    65. If Geburtstag = "" Or Geburtstag = "01.01.4501" Then
    66. Geburtstag = ""
    67. Else
    68. Geburtstag = myobj.Birthday
    69. End If
    70. cmd.CommandText = "INSERT into WW_Personen (P_RefFirma, " & _
    71. "P_Anrede, " & _
    72. "P_Titel, " & _
    73. "P_Vorname, " & _
    74. "P_Nachname, " & _
    75. "P_Position, " & _
    76. "P_Tel1, " & _
    77. "P_Tel2, " & _
    78. "P_Mobil, " & _
    79. "P_Fax, " & _
    80. "P_Mail1, " & _
    81. "P_Mail2, " & _
    82. "P_TelPrv, " & _
    83. "P_MobilPrv, " & _
    84. "P_StrPrv, " & _
    85. "P_PlzPrv, " & _
    86. "P_OrtPrv, " & _
    87. "P_Geburtstag, " & _
    88. "P_Partner, " & _
    89. "P_Du, " & _
    90. "P_StrFir, " & _
    91. "P_PlzFir, " & _
    92. "P_OrtFir, " & _
    93. "P_Firma, " & _
    94. "P_PersNewLetter, " & _
    95. "P_PersNewLOK, " & _
    96. "P_Hauptkontakt) " & _
    97. "VALUES (" & _
    98. "" & REF_Fa & ", " & _
    99. "'" & myobj.Title & "', " & _
    100. "'', " & _
    101. "'" & myobj.FirstName & "', " & _
    102. "'" & myobj.LastName & "', " & _
    103. "'" & myobj.JobTitle & "', " & _
    104. "'" & myobj.BusinessTelephoneNumber & "', " & _
    105. "'', " & _
    106. "'" & myobj.MobileTelephoneNumber & "', " & _
    107. "'" & myobj.BusinessFaxNumber & "', " & _
    108. "'" & myobj.Email1Address & "', " & _
    109. "'', " & _
    110. "'" & myobj.HomeTelephoneNumber & "', " & _
    111. "'', " & _
    112. "'" & myobj.HomeAddressStreet & "', " & _
    113. "'" & myobj.HomeAddressPostalCode & "', " & _
    114. "'" & myobj.HomeAddressCity & "', " & _
    115. "'" & myobj.Birthday & "', " & _
    116. "'" & myobj.Spouse & "', " & _
    117. "'False', " & _
    118. "'" & myobj.BusinessAddressStreet & "', " & _
    119. "'" & myobj.BusinessAddressPostalCode & "', " & _
    120. "'" & myobj.BusinessAddressCity & "', " & _
    121. "'" & myobj.CompanyName & "', " & _
    122. "'False', " & _
    123. "'False', " & _
    124. "'False')"
    125. Try
    126. cmd.ExecuteNonQuery()
    127. Catch ex As Exception
    128. con.Close()
    129. Fehlermeldung = ex.Message & " - Fehler: Kunde_1, DragDrop__Personen_Funtkion" & vbCrLf & vbCrLf & cmd.CommandText
    130. Fehler_Instance.Ausgabe(Fehlermeldung)
    131. End Try
    132. End If
    133. con.Close()
    134. Schlussarbeiten()
    135. Datensaetze_laden()
    136. End Sub

    -hier

    VB.NET-Quellcode

    1. Dim outlookApplication = New ApplicationClass()


    Gibt er mir ne Meldung aus, die ich nicht verstehe... Könntest du mir da weiterhelfen ?

    Der Interoptyp "ApplicationClass" kann nicht eingebettet werden. Verwenden Sie stattdessen die entsprechende Schnittstelle.

    Probier mal folgendes.

    VB.NET-Quellcode

    1. Dim OutlookApplication As Outlook.Application = Nothing
    2. Dim MapiNamespace As Outlook.NameSpace = Nothing
    3. Dim Contacts As Outlook.MAPIFolder = Nothing
    5. OutlookApplication = New Outlook.Application()
    6. MapiNamespace = OutlookApplication.GetNamespace("MAPI")
    7. Contacts = MapiNamespace.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderContacts)

    ok... bin schon dabei meinen Code umzuschreiben...


    Hast du vielleicht noch eine Idee zum Select bei diesem Abschnitt vom neuen Code:

    VB.NET-Quellcode

    1. For i As Integer = 1 To contacts.Items.Count


    also so was in der Art wie:

    VB.NET-Quellcode

    1. For i As Integer = 1 To contacts.Items.Selection.count


    ?

    Das ist nun mein Versuch mit MAPI zu arbeiten.

    Jedoch habe ich hier das Problem noch, dass er einfach immer alle Kontakte durchläuft.
    Er soll mir aber nur den makierten Kontakt ausgeben... also markiert in Outlook.

    Ist der Code total falsch, oder bin ich auf dem richtigen Weg?

    VB.NET-Quellcode

    1. Sub test()
    2. On Error Resume Next
    4. Dim app As New Microsoft.Office.Interop.Outlook.Application
    5. Dim ns As Microsoft.Office.Interop.Outlook.NameSpace
    6. Dim myContacts As Microsoft.Office.Interop.Outlook.MAPIFolder
    7. Dim myContact As Microsoft.Office.Interop.Outlook.ContactItem
    9. ns = app.GetNamespace("MAPI")
    10. myContacts = ns.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderContacts)
    11. For i = 1 To myContacts.Items.Count
    12. MsgBox(myContacts.Items(i).LastName)
    13. Next
    14. End Sub

    Hallo Singu,

    deine Frage bzgl. warum ich nur die markierten Kontakte auslesen will hat mich zum nachdenken gebracht.
    Ich habe daher meinen Plan alle Kontakte einzeln hin und her zu schieben (Outlook <> meine Datenbank und umgedreht) verworfen. Deine Frage hat mir gezeigt, dass dies viel zum umständlich wäre. ... danke das du mich zum grübeln gebracht hast :)

    Nach einiger Überlegungen habe ich mich nun dazu entschlossen, meine eigene Datenbank mit den Kontakten ähnlich wie eine Syncronisation mit Outlook abgleichen zu lassen.
    Jedoch mit der Bedingung, diese Kontakte werden ausschließlich in meiner Datenbank verwaltet - weil da viele weitere Informationen (Felder) vorhanden sind, für die es im Outlook nicht mal ein Feld gibt... und so tief möchte ich dann auch nicht einsteigen.

    Nun stelle ich es mir so vor...
    Kontakte werden in meine Datenbank / meinem Programm verwaltet. User kann einen Button drücken "syncronisieren mit Outlook" und dann sollen die Kontakte die in meiner Datenbank vorhanden sind erstmal alle gelöscht werden und anschließend neu angelegt werden - der einfachste weg ! ?? oder ??

    Unterscheiden tu ich zwei Datenbanktabellen: Firmen und Personen. Beide werden mir einer Kategorie versehen (OUTLOOK [Categories]) und nur die sollen bearbeitet werden in Verbindung mit einer Suchabfrage halt...

    Hier erstmal mein Code, so wie ich mir das bisher gedacht habe:

    VB.NET-Quellcode

    1. Private Sub Kunde_Person_Outl_SYNC_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
    2. Firmen_durchlaufen()
    4. End Sub
    6. Private Sub Firmen_durchlaufen()
    7. Dim con As New OleDb.OleDbConnection
    8. Dim cmd As New OleDb.OleDbCommand
    9. Dim reader As OleDb.OleDbDataReader
    10. con.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source =" & Form1.Archiv_aktiv & "; Jet OLEDB:database Password=" & DBPass & ";"
    11. cmd.Connection = con
    12. cmd.CommandText = "SELECT * FROM WW_Firmen WHERE FA_Status = 'aktiv' AND ID = 1"
    13. Try
    14. con.Open()
    15. reader = cmd.ExecuteReader()
    16. Do While reader.Read()
    17. FindContact__Firmen(reader("FA_Name1").ToString, reader("FA_Plz").ToString, reader("FA_Ort").ToString)
    18. Loop
    19. con.Close()
    21. Catch ex As Exception
    22. MessageBox.Show("Fehler beim Abrufen der Firmen", "DIMS Info", MessageBoxButtons.OK, MessageBoxIcon.Error)
    23. Finally
    24. con.Close()
    25. End Try
    26. End Sub
    28. Sub FindContact__Firmen(ByVal Firma As String, ByVal Plz As String, ByVal Ort As String)
    29. Try
    30. Dim olApp As Outlook.Application
    31. Dim objContact As Outlook.ContactItem
    32. Dim objContacts As Outlook.MAPIFolder
    33. Dim objNameSpace As Outlook.NameSpace
    34. Dim Kategorie As String = "DIMS Firmen"
    35. olApp = CreateObject("Outlook.Application")
    36. objNameSpace = olApp.GetNamespace("MAPI")
    37. objContacts = objNameSpace.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderContacts)
    39. Dim suchen As String = "[CompanyName]='" & Firma & "' AND [Categories]='" & Kategorie & "'"
    40. ' and [BusinessAddressPostalCode] ='" & Plz & "' and [BusinessAddressCity] ='" & Ort & "'
    42. objContact = objContacts.Items.Find(suchen)
    44. Do While TypeName(objContact) IsNot Nothing
    45. objContact = objContacts.Items.Find(suchen)
    46. If Not TypeName(objContact) = "Nothing" Then
    47. objContact.Delete()
    48. Else
    49. MsgBox("nicht gefunden...")
    50. End If
    51. Loop
    52. Catch ex As Exception
    53. MessageBox.Show("Fehler... " & ex.Message, "DIMS Info...", MessageBoxButtons.OK, MessageBoxIcon.Error)
    54. End Try
    56. End Sub


    Testen konnte ich es derzeit noch nicht, da ich beim Ausführen eine Fehlermeldung erhalte: "Die Bedingung ist falsch..." mehr Informaiton erhalte ich leider nicht....

    Kannst du Dir vielleicht vorstellen was diese Fehlermeldung bedeuten könnte ???


    Hast du schon mal so eine "syncronisation" versucht umzusetzen ?

    Viele Grüße lris

    Hallo Singu,

    also ich habe dieses Projekt mir Übernahme kompl. umgeshmissen und habe auch eine Art syncronisierung gemacht.
    Allerdings funktioniert diese auf der Basis, alter Kontakt in Outlook löschen und neuen anlegen... klappt bis jetzt sehr sehr gut... nur aufpassen mit dem Postkopf (gelöschte Objekte) der kann schnell sehr voll werden und wenn du an einem Exchange hängst, könnte es sein, dass irgendwann dein Postfach zu voll ist - also leeren...

    hier mal mein Kompl. Code von meiner "syncronisierung" :)


    Vielleicht bringts Dich ja auch gute Idee'n :)


    VB.NET-Quellcode

    1. Imports System.Data.SqlClient
    2. Imports Microsoft.Office.Interop
    3. Imports System.Data.OleDb
    4. Imports System.IO
    6. Public Class Kunde_Person_Outl_SYNC
    7. Private DBPass As String = "IRGENDEINKENNWORT"
    8. Private Fehlerliste As List(Of String)
    10. ' Firmen
    11. Private dt1 As New DataTable
    12. Private da1 As OleDbDataAdapter
    13. Private ds1 As New DataSet
    14. Private bs1 As New BindingSource
    16. ' Personen
    17. Private dt2 As New DataTable
    18. Private da2 As OleDbDataAdapter
    19. Private ds2 As New DataSet
    20. Private bs2 As New BindingSource
    22. 'Bearbeiter
    23. Private dt3 As New DataTable
    24. Private da3 As OleDbDataAdapter
    25. Private ds3 As New DataSet
    26. Private bs3 As New BindingSource
    28. Dim Progress As Double
    30. Private Sub Kunde_Person_Outl_SYNC_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
    31. ComboBox1.SelectedIndex = 0
    32. Kundenliste_laden()
    33. Personen_laden()
    34. Bearbeiter_laden()
    35. End Sub
    37. Private Sub WW_Kunde_Close(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.FormClosed
    38. ds1.Tables.Clear()
    39. dt1.Clear()
    40. ds2.Tables.Clear()
    41. dt2.Clear()
    42. ds3.Tables.Clear()
    43. dt3.Clear()
    45. End Sub
    47. Private Sub Form_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles MyBase.KeyDown
    48. If (e.KeyCode = Keys.Escape) Then
    49. Me.Close()
    50. End If
    51. End Sub
    53. Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
    54. Progress = 0
    55. ProgressBar1.Value = 0
    56. ProgressBar2.Value = 0
    57. If ComboBox1.Text = "alles" Then
    58. Firmen_erstellen(dt1)
    59. Person_erstellen(dt2)
    60. Bearbeiter_erstellen(dt3)
    61. ElseIf ComboBox1.Text = "nur Firmen" Then
    62. Firmen_erstellen(dt1)
    63. ElseIf ComboBox1.Text = "nur Personen" Then
    64. Person_erstellen(dt2)
    65. Else
    66. Bearbeiter_erstellen(dt3)
    67. End If
    68. End Sub
    70. Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
    71. Progress = 0
    72. ProgressBar1.Value = 0
    73. ProgressBar2.Value = 0
    74. End Sub
    76. Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
    77. Progress = 0
    78. ProgressBar1.Value = 0
    79. ProgressBar2.Value = 0
    80. Me.Close()
    81. End Sub
    83. Private Sub Kundenliste_laden()
    84. Dim Filter As String = "SELECT * FROM WW_Firmen WHERE FA_Status = 'aktiv';" ' WHERE ID=1
    85. Dim ConStr As String = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source =" & Form1.Archiv_aktiv & "; Jet OLEDB:database Password=" & DBPass & ";"
    86. Dim Con As New OleDbConnection(ConStr)
    87. da1 = New OleDbDataAdapter(Filter, Con)
    88. ds1.Tables.Add(dt1)
    89. da1.Fill(dt1)
    91. Label7.Text = dt1.Rows.Count & " Stk."
    93. End Sub
    95. Private Sub Personen_laden()
    96. Dim Filter As String = "SELECT * FROM WW_Personen;" ' WHERE P_ID=178
    97. Dim ConStr As String = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source =" & Form1.Archiv_aktiv & "; Jet OLEDB:database Password=" & DBPass & ";"
    98. Dim Con As New OleDbConnection(ConStr)
    99. da2 = New OleDbDataAdapter(Filter, Con)
    100. ds2.Tables.Add(dt2)
    101. da2.Fill(dt2)
    103. Label8.Text = dt2.Rows.Count & " Stk."
    105. End Sub
    107. Private Sub Bearbeiter_laden()
    108. Dim Filter As String = "SELECT * FROM Bearbeiter;" ' WHERE P_ID=178
    109. Dim ConStr As String = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source =" & Form1.Archiv_aktiv & "; Jet OLEDB:database Password=" & DBPass & ";"
    110. Dim Con As New OleDbConnection(ConStr)
    111. da3 = New OleDbDataAdapter(Filter, Con)
    112. ds3.Tables.Add(dt3)
    113. da3.Fill(dt3)
    115. Label12.Text = dt3.Rows.Count & " Stk."
    117. End Sub
    119. Public Sub Firmen_erstellen(ByVal dt_Ma As DataTable)
    120. Button3.Enabled = False
    121. Dim count As Integer = dt_Ma.Rows.Count
    122. Try
    123. For Each r As DataRow In dt_Ma.Rows
    125. Dim olApp As Outlook.Application
    126. olApp = CreateObject("Outlook.Application")
    128. Dim olNs As Outlook.NameSpace
    129. olNs = olApp.GetNamespace("MAPI")
    130. olNs.Logon()
    132. Try
    133. Firmen__loeschen(r("ID").ToString)
    134. Catch ex As Exception
    136. End Try
    138. Dim olItem As Outlook.ContactItem
    139. olItem = olApp.CreateItem(Outlook.OlItemType.olContactItem)
    141. ' Zusammenfassung Body
    142. Dim BodyInfo As String = "ABC Kz. " & r("FA_abc").ToString & vbCrLf & _
    143. "Kategorie: " & r("FA_Kategorie").ToString & vbCrLf & _
    144. "Liefersperre HA: " & r("FA_Liefersperre").ToString & vbCrLf & _
    145. "Rückfrage HA: " & r("FA_Rueckfrage").ToString
    147. With olItem
    148. .TelexNumber = "DIMS_Firma"
    149. .CustomerID = r("ID").ToString
    150. .Categories = "DIMS Firmen"
    151. .CompanyName = r("FA_Name1").ToString
    152. .LastName = r("FA_Matchcode").ToString
    153. .BusinessAddressStreet = r("FA_Strasse").ToString
    154. .BusinessAddressPostalCode = r("FA_Plz").ToString
    155. .BusinessAddressCity = r("FA_Ort").ToString
    156. .BusinessTelephoneNumber = r("FA_Tel1").ToString
    157. .BusinessFaxNumber = r("FA_Fax").ToString
    158. .Email1Address = r("FA_Email").ToString
    159. .BusinessHomePage = r("FA_www").ToString
    160. .Body = BodyInfo
    161. End With
    163. olItem.Save()
    164. olNs.Logoff()
    165. olNs = Nothing
    166. olItem = Nothing
    167. olApp = Nothing
    169. Progress = Progress + (100 / count) '- 1
    170. If Progress >= 100 Then
    171. Progress = 100
    172. End If
    173. ProgressBar1.Value = Progress
    174. Next
    175. Catch ex As System.Exception
    176. MsgBox("Fehler, nicht alle Kontakte an Outlook übergeben" & _
    177. vbLf & vbLf & ex.ToString())
    178. Button3.Enabled = True
    179. End Try
    180. Button3.Enabled = True
    181. End Sub
    184. Private Sub Firmen__loeschen(ByVal FID As String)
    185. Dim suchen As String = "[CustomerID]='" & FID & " AND [TelexNumber]='DIMS_Firma'"
    186. Dim olApp As Outlook.Application
    187. Dim objContact As Outlook.ContactItem
    188. Dim objContacts As Outlook.MAPIFolder
    189. Dim objNameSpace As Outlook.NameSpace
    190. Try
    191. olApp = CreateObject("Outlook.Application")
    192. objNameSpace = olApp.GetNamespace("MAPI")
    193. objContacts = objNameSpace.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderContacts)
    195. objContact = objContacts.Items.Find(suchen)
    196. If Not TypeName(objContact) = "Nothing" Then
    197. objContact.Delete()
    198. End If
    199. Catch ex As System.Exception
    200. Fehlerliste.Add("Not found, Firma: " & suchen)
    201. End Try
    203. End Sub
    205. Public Sub Person_erstellen(ByVal dt_Ma2 As DataTable)
    206. Button3.Enabled = False
    207. Dim count2 As Integer = dt_Ma2.Rows.Count
    208. Try
    209. For Each r As DataRow In dt_Ma2.Rows
    211. Dim olApp As Outlook.Application
    212. olApp = CreateObject("Outlook.Application")
    214. Dim olNs As Outlook.NameSpace
    215. olNs = olApp.GetNamespace("MAPI")
    216. olNs.Logon()
    218. Try
    219. Personen__Loeschen(r("P_ID").ToString)
    220. Catch ex As Exception
    222. End Try
    224. Dim olItem As Outlook.ContactItem
    225. olItem = olApp.CreateItem(Outlook.OlItemType.olContactItem)
    227. Dim BodyInfo As String = "persönl. Ansprache mit du: " & r("P_Du").ToString & vbCrLf & _
    228. "Prv. Mobiltel.: " & r("P_MobilPrv").ToString & vbCrLf & _
    229. "Geb.tag Partner: " & r("P_PartnerinGebTag").ToString
    232. With olItem
    233. .TelexNumber = "DIMS_Person"
    234. .CustomerID = r("P_ID").ToString
    235. .Categories = "DIMS Personen"
    236. .Title = r("P_Anrede").ToString
    237. .Suffix = r("P_Titel").ToString
    238. .FirstName = r("P_Vorname").ToString
    239. .LastName = r("P_Nachname").ToString
    240. .JobTitle = r("P_Position").ToString
    241. .BusinessTelephoneNumber = r("P_Tel1").ToString
    242. .MobileTelephoneNumber = r("P_Mobil").ToString
    243. .BusinessFaxNumber = r("P_Fax").ToString
    244. .Email1Address = r("P_Mail1").ToString
    245. .HomeTelephoneNumber = r("P_TelPrv").ToString
    246. .HomeAddressStreet = r("P_StrPrv").ToString
    247. .HomeAddressPostalCode = r("P_PlzPrv").ToString
    248. .HomeAddressCity = r("P_OrtPrv").ToString
    249. If r("P_Geburtstag").ToString = "" Then
    250. Else
    251. .Birthday = CDate(r("P_Geburtstag").ToString)
    252. End If
    253. .Spouse = r("P_Partner").ToString
    254. .BusinessAddressStreet = r("P_StrFir").ToString
    255. .BusinessAddressPostalCode = r("P_PlzFir").ToString
    256. .BusinessAddressCity = r("P_OrtFir").ToString
    257. .CompanyName = r("P_Firma").ToString
    258. .Body = BodyInfo
    259. Try
    260. If r("P_BildDateiName").ToString <> "" Then
    261. .AddPicture(Form1.Archiv_Pfad & _
    262. "\FILES_" & Form1.Archiv_Name & _
    263. "\FILES\Pers_SECRET\" & _
    264. r("P_BildDateiName").ToString & ".jpg")
    265. End If
    266. Catch ex As System.Exception
    267. 'keine Fehlermeldung- weitermachen...
    268. End Try
    269. End With
    271. olItem.Save()
    272. olNs.Logoff()
    273. olNs = Nothing
    274. olItem = Nothing
    275. olApp = Nothing
    277. Progress = Progress + (100 / count2) '- 1
    278. If Progress >= 100 Then
    279. Progress = 100
    280. End If
    281. ProgressBar2.Value = Progress
    283. Next
    284. Catch ex As System.Exception
    285. MsgBox("Fehler bei Personen" & _
    286. vbLf & vbLf & ex.ToString())
    287. End Try
    288. Button3.Enabled = True
    289. End Sub
    291. Private Sub Personen__Loeschen(ByVal PID As String)
    292. Dim suchen As String = "[CustomerID] =" & PID & " AND [TelexNumber]='DIMS_Person'"
    293. Try
    294. Dim olApp As Outlook.Application
    295. Dim objContact As Outlook.ContactItem
    296. Dim objContacts As Outlook.MAPIFolder
    297. Dim objNameSpace As Outlook.NameSpace
    298. olApp = CreateObject("Outlook.Application")
    299. objNameSpace = olApp.GetNamespace("MAPI")
    300. objContacts = objNameSpace.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderContacts)
    301. objContact = objContacts.Items.Find(suchen)
    302. If Not TypeName(objContact) = "Nothing" Then
    303. objContact.Delete()
    304. End If
    305. Catch ex As System.Exception
    306. Fehlerliste.Add("Not found, Person: " & suchen)
    307. End Try
    308. End Sub
    310. Private Sub Bearbeiter_erstellen(ByVal dt_Ma2 As DataTable)
    311. ' noch keine Funktion, da die Maske für Bearbeiter erst umgestellt werden muß. Es muß auf Basis einer Formerfassung mit Bild umgestellt werden.
    313. End Sub
    315. End Class

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „lris08“ ()

    Der Fehler ist aufgetaucht, weil ich versucht habe auf "Categories" zuzugreifen - jedoch funktioniert das nicht, weil lt. MSDN Beschreibung Categories nur als Read möglich ist...
    Hab das Umgangen und mit ein Feld gesucht, dass heute nicht mehr verwendet wird.. z.B. Telex, verwendet keiner mehr... und habe da nun einen Wert eingesetzt.

    Damit ist der Fehler nicht mehr existent :)

    Danke aber !! :)


    EDIT: Wie findest meine Lösung zum "syncronisieren" ?? :)

Facebook
Telefonspende