mainform.vb

CRM ADD 联系人和修改处理,非常理想的一个联系人处理程序

    Private Sub ShowErrorMessage(ByVal genericException As Exception)

        Try

            MessageBox.Show("Error: " + genericException.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Exclamation, MessageBoxDefaultButton.Button1, MessageBoxOptions.DefaultDesktopOnly)

        Catch ex As Exception

            MessageBox.Show("Error: " + ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Exclamation, MessageBoxDefaultButton.Button1, MessageBoxOptions.DefaultDesktopOnly)

        End Try

    End Sub

    Private Sub CreateContactRecord()

        Try

            With (New AddContactForm)

                Select Case .ShowDialog

                    Case DialogResult.OK

                        ' strServer should be set with the name of the platform Web server

                        Dim Server As String = MSCRMServerTextBox.Text

                        ' strVirtualDirectory should be set with the name of the Microsoft CRM

                        ' virtual directory on the platform Web server

                        Dim VirtualDirectory As String = "mscrmservices"

                        Dim Dir As String = "http://" + Server + "/" + VirtualDirectory + "/"

                        ' BizUser proxy object

                        Dim BizUser As New Microsoft.CRM.Proxy.BizUser

                        BizUser.Credentials = New Net.NetworkCredential(UserNameTextBox.Text, PasswordTextBox.Text, Domain.Text)

                        BizUser.Url = Dir + "BizUser.srf"

                        ' CRMContact proxy object

                        Dim Contact As New Microsoft.CRM.Proxy.CRMContact

                        Contact.Credentials = System.Net.CredentialCache.DefaultCredentials

                        Contact.Url = Dir + "CRMContact.srf"

                        Dim UserAuth As Microsoft.CRM.Proxy.CUserAuth = BizUser.WhoAmI()

                        Dim ContactXml As String = "<contact>"

                        ContactXml += "<firstname>" + .FirstNameTextBox.Text + "</firstname>"

                        ContactXml += "<lastname>" + .LastNameTextBox.Text + "</lastname>"

                        ContactXml += "<emailaddress1>" + .EmailAddressTextBox.Text + "</emailaddress1>"

                        ContactXml += "<telephone1>" + .TelephoneTextBox.Text + "</telephone1>"

                        ContactXml += "<ownerid type='" + Microsoft.CRM.Flags.ObjectType.otSystemUser.ToString() + "'>"

                        ContactXml += UserAuth.UserId + "</ownerid>"

                        ContactXml += "</contact>"

                        Dim ContactId As String = Contact.Create(UserAuth, ContactXml)

                End Select

            End With

        Catch err As System.Web.Services.Protocols.SoapException

            ShowErrorMessage(err)

        Catch ex As Exception

            ShowErrorMessage(ex)

        End Try

    End Sub

    Private Sub ModifyContactInformation()

        Try

            Dim ContactId As String

            With InputBox("Please enter a Contact Id:", "Enter Contact Id")

                ContactId = .Trim.ToUpper

            End With

            If Not (New Guid(ContactId).Equals(Guid.Empty)) Then

                ' strServer should be set with the name of the platform Web server

            Dim Server As String = MSCRMServerTextBox.Text

            ' strVirtualDirectory should be set with the name of the Microsoft CRM

            ' virtual directory on the platform Web server

            Dim VirtualDirectory As String = "mscrmservices"

            Dim Dir As String = "http://" + Server + "/" + VirtualDirectory + "/"

            ' BizUser proxy object

            Dim BizUser As New Microsoft.CRM.Proxy.BizUser

            BizUser.Credentials = New Net.NetworkCredential(UserNameTextBox.Text, PasswordTextBox.Text, Domain.Text)

            BizUser.Url = Dir + "BizUser.srf"

            ' CRMContact proxy object

            Dim Contact As New Microsoft.CRM.Proxy.CRMContact

            Contact.Credentials = System.Net.CredentialCache.DefaultCredentials

            Contact.Url = Dir + "CRMContact.srf"

            Dim ErrorMsg As String

            Dim ContactXml As String

            Try

                Dim UserAuth As Microsoft.CRM.Proxy.CUserAuth = BizUser.WhoAmI()

                Dim XmlDoc As New System.Xml.XmlDocument

                XmlDoc.LoadXml(ContactXml)


                ContactXml = Contact.Retrieve(UserAuth, ContactId, "")

                With (New ModifyContactForm)

                    .FirstNameTextBox.Text = GetNodeValue(XmlDoc, "firstname")

                    .LastNameTextBox.Text = GetNodeValue(XmlDoc, "lastname")

                    .EmailAddressTextBox.Text = GetNodeValue(XmlDoc, "emailaddress1")

                    .TelephoneTextBox.Text = GetNodeValue(XmlDoc, "telephone1")

                    Select Case .ShowDialog

                        Case DialogResult.OK

                            Dim UpdateContactXml As String = "<contact>"

                            UpdateContactXml += "<firstname>" + .FirstNameTextBox.Text + "</firstname>"

                            UpdateContactXml += "<lastname>" + .LastNameTextBox.Text + "</lastname>"

                            UpdateContactXml += "<emailaddress1>" + .EmailAddressTextBox.Text + "</emailaddress1>"

                            UpdateContactXml += "<telephone1>" + .TelephoneTextBox.Text + "</telephone1>"

                            UpdateContactXml += "</contact>"

                            Contact.Update(UserAuth, ContactId, UpdateContactXml)

                    End Select

                End With

            Catch err As System.Web.Services.Protocols.SoapException

                ShowErrorMessage(err)

                End Try

            End If

        Catch ex As Exception

            ShowErrorMessage(ex)

        End Try

    End Sub


#End Region

#End Region

#Region "Functions"

#Region "Private Functions"

    Private Function GetAllContacts() As System.Xml.XmlDocument

        Try

            ' strServer should be set with the name of the platform Web server

            Dim Server As String = MSCRMServerTextBox.Text

            ' strVirtualDirectory should be set with the name of the Microsoft CRM

            ' virtual directory on the platform Web server

            Dim VirtualDirectory As String = "mscrmservices"

            Dim Dir As String = "http://" + Server + "/" + VirtualDirectory + "/"

            ' BizUser proxy object

            Dim BizUser As New Microsoft.CRM.Proxy.BizUser

            BizUser.Credentials = New Net.NetworkCredential(UserNameTextBox.Text, PasswordTextBox.Text, Domain.Text)

            BizUser.Url = Dir + "BizUser.srf"

            ' Query proxy object

            Dim Query As New Microsoft.CRM.Proxy.CRMQuery

            Query.Credentials = System.Net.CredentialCache.DefaultCredentials

            Query.Url = Dir + "CRMQuery.srf"

            Dim ErrorMsg As String

            Dim Contacts As String

            Try

                Dim UserAuth As Microsoft.CRM.Proxy.CUserAuth = BizUser.WhoAmI()

                ' This is "select * from Contact" and will return all

                ' contacts for which you have read access

                Dim strQuery As String = "<fetch mapping='logical'><entity name='contact'><all-attributes/></entity></fetch>"

                ' This should return a resultset with all the contacts you can see

                Contacts = Query.ExecuteQuery(UserAuth, strQuery)

                Dim XmlDoc As New System.Xml.XmlDocument

                XmlDoc.LoadXml(Contacts)

                Return XmlDoc

            Catch err As System.Web.Services.Protocols.SoapException

                ShowErrorMessage(err)

            End Try

        Catch ex As Exception

            ShowErrorMessage(ex)

        End Try

    End Function

    Private Function GetNodeValue(ByVal inputXML As Xml.XmlDocument, ByVal searchName As String) As String

        Try

            Return inputXML.SelectNodes(("descendant::" + searchName)).Item(0).InnerText

        Catch ex As Exception

            ShowErrorMessage(ex)

        End Try

    End Function

#End Region

#End Region

#Region "Control Events"

    Private Sub RefreshButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RefreshButton.Click

        Try

            MyDataSet.ReadXml(New Xml.XmlNodeReader(GetAllContacts()))

        Catch ex As Exception

            ShowErrorMessage(ex)

        End Try

    End Sub

    Private Sub AddContactButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles AddContactButton.Click

        Try

            Call CreateContactRecord()

        Catch ex As Exception

            ShowErrorMessage(ex)

        End Try

    End Sub

    Private Sub ModifyContactButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ModifyContactButton.Click

        Try

            Call ModifyContactInformation()

        Catch ex As Exception

            ShowErrorMessage(ex)

        End Try

    End Sub

    Private Sub AboutMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles AboutMenuItem.Click

        Try

            MsgBox("Windows Form Example for MSCRM SDK: 'Add / Remove Contact', by Jason Craig ([e-mail])", MsgBoxStyle.Information, "About")

        Catch ex As Exception

            ShowErrorMessage(ex)

        End Try

    End Sub

    Private Sub ExitMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ExitMenuItem.Click

        Try

            Call Close()

        Catch ex As Exception

            ShowErrorMessage(ex)

        End Try

    End Sub

#End Region

End Class