Dashboard > Documentation for Metrix Developers and Consultants > ... > Modules > How to be able to add contacts "on the fly"
Documentation for Metrix Developers and Consultants Log In   View a printable version of the current page.
How to be able to add contacts "on the fly"
Browse Space    
Added by Sean DeWitt, last edited by Sean DeWitt on Jan 17, 2006
Labels: 

Adding Contacts "On the Fly"

Often, users need the ability to add a contact from within a certain context. You do not want to interrupt their workflow to have them use the traditional "add contact" methodology in Metrix. Here is one way that I have designed to have this work:

How the user triggers the "add contact": using a union query to populate the rowsource of "ContactName"

In my situation, users are entering data on a custom form that is associated with an Interaction. One of the custom fields is "Contact Name", which is a combo box (drop-down list) with a list of all contacts in the Metrix database. Sometimes though, the contact has not yet been added to the database, and the user needs to add the contact from within this context.

In this case, I have changed the view that is the RowSource value of the combo box to union in a value as the first in the list that reads "<<Add New Contact>>". This first value would be followed by the usual list of contacts in the database. Here is the text of the view I use:

SELECT TOP 100 PERCENT ContactID, ContactName
FROM dbo.tblContacts
ORDER BY ContactName
UNION
SELECT 0 AS ContactID, '<<Add New Contact>>' as ContactName

OnChange event of "ContactName"

The following event allows you to trap the case where "<<Add New Contact>>" is chosen in the combo box and call the Function that opens the contact form:

Private Sub cmbContactName_Change()
'If the value is to add a new Contact
If Me.cmbContactName = 0 Then
Me.cmbContactName = ""
If MsgBox("Would you like to add a new contact to the database now?", vbYesNo, "Add New Contact") <> vbYes Then
Exit Sub
'open the add contact form (ad-hoc)
End If
Call OpenAddContactForm
Set gctl = Me!cmbContactName
Set gfrm = Me
Exit Sub
End If
End Sub

Code in module

Put the following code in a new custom module (ensure you use the word "custom" in its name):

Option Compare Database
Option Explicit

Public gctl As Control
Public gfrm As Form

Public Function OpenAddContactForm()
Call DoCmd.OpenForm("frmCustom_FNDRSG_AddContactContext", acNormal)
End Function

Public Function AddValueToForm(lngContactID As Long)
Dim strContactName As String
strContactName = DLookup("ContactName", "tblContacts", "ContactID = " & lngContactID)
gfrm.Controls(gctl.Name).Requery
gfrm.Controls(gctl.Name) = lngContactID
'move the focus to the row that has the value for this ContactID
If SysCmd(acSysCmdGetObjectState, acForm, "frmContacts") > 0 Then
Forms!frmContacts.Requery
End If
End Function

Add these two stored procedures to your build (rename here and in the code as needed)

/****** Object: Stored Procedure dbo.spCustomContactIsDup Script Date: 1/16/2006 4:09:12 PM ******/

CREATE PROCEDURE dbo.spCustomContactIsDup
(@sortname nvarchar (200), @ysndup bit = 0 OUTPUT)
AS

If Exists( SELECT SortName, COUNT(SortName)
AS CountOfSortName FROM dbo.tblContacts
GROUP BY SortName
HAVING (SortName = @sortname) AND (COUNT(SortName) > 0) )
SET @ysndup = 1
Else
SET @ysndup = 0

GO
=============-

CREATE PROCEDURE spCustom_FNDRSG_InsertIntoTblContactLocations

(
@addresstype nvarchar(50),
@addressline1 nvarchar(100),
@addressline2 nvarchar(100),
@city nvarchar(50),
@state nvarchar(50),
@zip nvarchar(50),
@country nvarchar(50),
@phone nvarchar(50),
@fax nvarchar(50),
@email nvarchar(100),
@website nvarchar(100),
@contactid int,
@pcl bit
)
AS
INSERT INTO tblContactLocations(ContactLocationName, AddressLine1,
AddressLine2, City, StateProv, ZIPPostalCode,
Country, Phone, Fax, Email, URL, ContactID, PCL)
VALUES(@addresstype, @addressline1, @addressline2, @city, @state, @zip,
@country, @phone, @fax, @email, @website, @contactid, @pcl)

GO

use loadfromtext(...) to work the "add contact" form into your build

Below is the text you can use to create the "add contact" form. To do so, follow these steps:
1. Copy the code below into a text file, and save it as "C:\addcontactform.txt"
2. Open Metrix with the <shift> key bypass
3. Press <ctrl-G> to view the code window
4. In the immediate window, type the following statement and press enter:
call loadfromtext(acForm, "frmCustom_FNDRSG_AddContactContext", "C:\addcontactform.txt")

------
Version =19
VersionRequired =19
Checksum =67351032
Begin Form
AllowFilters = NotDefault
PopUp = NotDefault
RecordSelectors = NotDefault
ShortcutMenu = NotDefault
AutoCenter = NotDefault
NavigationButtons = NotDefault
DividingLines = NotDefault
MaxRecButton = NotDefault
DefaultView =0
AllowUpdating =4
ScrollBars =0
TabularFamily =96
PictureAlignment =2
DatasheetGridlinesBehavior =3
GridX =24
GridY =24
Width =7920
DatasheetFontHeight =10
ItemSuffix =89
Left =270
Top =1770
Right =8685
Bottom =7245
DatasheetGridlinesColor =12632256
Tag ="tblCustomOrganizationContacts"
RecSrcDt = Begin
0x27766effb4e9e240
End
Caption ="Add New Contact"
DatasheetFontName ="Arial"
Begin
Begin Label
BackStyle =0
FontName ="Tahoma"
End
Begin Image
BackStyle =0
OldBorderStyle =0
PictureAlignment =2
End
Begin CommandButton
FontSize =8
FontWeight =400
ForeColor =-2147483630
FontName ="Tahoma"
End
Begin CheckBox
LabelX =-1620
End
Begin TextBox
AddColon = NotDefault
FELineBreak = NotDefault
OldBorderStyle =0
Height =255
LabelX =-1620
ForeColor =-2147483640
End
Begin ComboBox
AddColon = NotDefault
OldBorderStyle =0
Width =2310
Height =255
LabelX =-1620
ForeColor =-2147483640
End
Begin Subform
SpecialEffect =2
End
Begin FormHeader
Height =960
BackColor =12632245
Name ="FormHeader"
GUID = Begin
0x03fd37ec7252634a803ffa0f6219efd8
End
Begin
Begin Label
OverlapFlags =85
TextFontFamily =0
Left =120
Top =240
Width =3720
Height =480
FontSize =14
FontWeight =700
Name ="Label59"
Caption ="Add a New Contact "
FontName ="scalasans-regular"
GUID = Begin
0x7ddee7933a3e394e88346bfe54181e86
End
End
End
End
Begin Section
CanGrow = NotDefault
Height =5520
Name ="Detail"
GUID = Begin
0x15a0268c39a811448978d8af105290f0
End
Begin
Begin TextBox
OldBorderStyle =1
OverlapFlags =95
IMESentenceMode =3
Left =1440
Top =1200
Width =1560
TabIndex =2
BackColor =14741489
BorderColor =6180920
Name ="txtNameFirst"
GUID = Begin
0xe616705c4740604a84f244d9b5379cd2
End
Begin
Begin Label
OverlapFlags =93
Left =1440
Top =960
Width =1020
Height =240
Name ="Label40"
Caption ="First Name"
GUID = Begin
0xb16ac9344c4a2247b223f7922a9059db
End
End
End
End
Begin TextBox
OldBorderStyle =1
OverlapFlags =95
IMESentenceMode =3
Left =3180
Top =1200
Width =1560
TabIndex =3
BackColor =14741489
BorderColor =6180920
Name ="txtNameMiddle"
GUID = Begin
0xdc7e229a9930cc4c816aac66514be2ef
End
Begin
Begin Label
OverlapFlags =93
Left =3180
Top =960
Width =1020
Height =240
Name ="Label42"
Caption ="Middle Name"
GUID = Begin
0xc778aacfa406164795c0950abdb159bc
End
End
End
End
Begin TextBox
OldBorderStyle =1
OverlapFlags =95
IMESentenceMode =3
Left =4920
Top =1200
Width =1560
TabIndex =4
BackColor =14741489
BorderColor =6180920
Name ="txtNameLast"
GUID = Begin
0x8cf4e49630bf9247be43fe61e78a9d90
End
Begin
Begin Label
OverlapFlags =93
Left =4920
Top =960
Width =1020
Height =240
Name ="Label44"
Caption ="Last Name"
GUID = Begin
0xf62d027112ccab4cbf8ebbc09cfc8b64
End
End
End
End
Begin ComboBox
OldBorderStyle =1
OverlapFlags =95
IMESentenceMode =3
Left =240
Top =1200
Width =1020
TabIndex =1
BackColor =14741489
BorderColor =6180920
ColumnInfo ="\"\";\"\";\"10\";\"14\""
GUID = Begin
0xf6265a4670556744bba8c31aa3a9d630
End
Name ="cmbNamePrefix"
RowSourceType ="Table/View/StoredProc"
RowSource ="SELECT Prefix FROM tlkpPrefix ORDER BY Prefix"
Begin
Begin Label
OverlapFlags =93
Left =240
Top =960
Width =1020
Height =240
Name ="Label36"
Caption ="Prefix"
GUID = Begin
0x65f3919961a2ab44bae10a3613f4518f
End
End
End
End
Begin ComboBox
OldBorderStyle =1
OverlapFlags =95
IMESentenceMode =3
Left =6660
Top =1200
Width =1020
TabIndex =5
BackColor =14741489
BorderColor =6180920
ColumnInfo ="\"\";\"\";\"10\";\"50\""
GUID = Begin
0xeea55672bbbcfd449e0bc0ecff3f2b42
End
Name ="cmbNameSuffix"
RowSourceType ="Table/View/StoredProc"
RowSource ="SELECT Suffix FROM tlkpSuffix ORDER BY Suffix"
Begin
Begin Label
OverlapFlags =93
Left =6660
Top =960
Width =1020
Height =240
Name ="Label46"
Caption ="Suffix"
GUID = Begin
0xb6acf76a81fdb24abe67b2f2e2bcab4c
End
End
End
End
Begin CommandButton
OverlapFlags =85
AccessKey =78
Left =2640
Top =4920
TabIndex =19
Name ="cmdAddContactFromContext"
Caption ="Add &New Contact"
OnClick ="[Event Procedure]"
GUID = Begin
0x20781b4cd5605247abaf943bf57ec2da
End
End
Begin CommandButton
OverlapFlags =85
AccessKey =67
Left =4200
Top =4920
TabIndex =20
Name ="cmdCancel"
Caption ="&Cancel"
OnClick ="[Event Procedure]"
GUID = Begin
0xe72f6812ce8f2642901b63ab7a3b0a46
End
End
Begin ComboBox
RowSourceTypeInt =1
OldBorderStyle =1
OverlapFlags =85
IMESentenceMode =3
Left =1380
Top =420
BackColor =14741489
BorderColor =6180920
GUID = Begin
0x172385a02c35424c85407ccb8e6913d1
End
Name ="cmbContactType"
RowSourceType ="Value List"
RowSource ="\"Individual\";\"Family\";\"Organization\""
AfterUpdate ="[Event Procedure]"
DefaultValue ="\"Individual\""
Begin
Begin Label
OverlapFlags =85
Left =180
Top =420
Width =1050
Height =240
Name ="Label61"
Caption ="Contact Type"
GUID = Begin
0xb51f5d4225e86e46804531d714145825
End
End
End
End
Begin TextBox
Visible = NotDefault
OldBorderStyle =1
OverlapFlags =255
IMESentenceMode =3
Left =240
Top =1200
Width =7440
TabIndex =6
BackColor =14741489
BorderColor =6180920
Name ="txtOrganizationName"
GUID = Begin
0xfd289e6089f3134fa87ab5b28778e776
End
Begin
Begin Label
OverlapFlags =223
Left =240
Top =960
Width =1440
Height =240
Name ="Label63"
Caption ="Organization Name"
GUID = Begin
0xc593b733a549534481ae39ef6cd6f6d9
End
End
End
End
Begin TextBox
Visible = NotDefault
OldBorderStyle =1
OverlapFlags =247
IMESentenceMode =3
Left =240
Top =1200
Width =7440
TabIndex =7
BackColor =14741489
BorderColor =6180920
Name ="txtFamilyName"
GUID = Begin
0x2b76b2b1947ba745932e406869f07907
End
Begin
Begin Label
OverlapFlags =255
Left =240
Top =960
Width =975
Height =240
Name ="Label65"
Caption ="Family Name"
GUID = Begin
0x2a5b61b9f548c74f931a3ffc3a5ee4f8
End
End
End
End
Begin TextBox
OldBorderStyle =1
OverlapFlags =85
IMESentenceMode =3
Left =1380
Top =2460
Width =6300
TabIndex =9
BackColor =14741489
BorderColor =6180920
Name ="txtAddressLine1"
GUID = Begin
0x9b6cce0d2994da4b8c0d9620f03a90f4
End
Begin
Begin Label
OverlapFlags =85
Left =240
Top =2460
Width =1125
Height =240
Name ="Label67"
Caption ="Address Line 1"
GUID = Begin
0xcc3505fdf799b2499a9f5bc3ef428624
End
End
End
End
Begin TextBox
OldBorderStyle =1
OverlapFlags =85
IMESentenceMode =3
Left =1380
Top =2820
Width =6300
TabIndex =10
BackColor =14741489
BorderColor =6180920
Name ="txtAddressLine2"
GUID = Begin
0x5b32560f8491934caf6823d66f62ac08
End
Begin
Begin Label
OverlapFlags =85
Left =240
Top =2820
Width =1125
Height =240
Name ="Label69"
Caption ="Address Line 2"
GUID = Begin
0x45e6f95ce638dd42ad6f103463d68727
End
End
End
End
Begin TextBox
OldBorderStyle =1
OverlapFlags =85
IMESentenceMode =3
Left =1380
Top =3180
TabIndex =11
BackColor =14741489
BorderColor =6180920
Name ="txtCity"
GUID = Begin
0x764b8ea2f1d6b74ca5790c9413fd1610
End
Begin
Begin Label
OverlapFlags =85
Left =240
Top =3195
Width =810
Height =240
Name ="Label71"
Caption ="City/Town"
GUID = Begin
0xa075905b6a2e3949abd66e64905bd8d3
End
End
End
End
Begin TextBox
OldBorderStyle =1
OverlapFlags =85
IMESentenceMode =3
Left =6240
Top =3180
TabIndex =13
BackColor =14741489
BorderColor =6180920
Name ="txtPostalCode"
GUID = Begin
0x55d1f7496e4acb4f880c80a73c8d5efd
End
Begin
Begin Label
OverlapFlags =85
Left =5220
Top =3195
Width =960
Height =240
Name ="Label75"
Caption ="Postal Code"
GUID = Begin
0x45c58d3228857747a3d13f85cdd8b3ff
End
End
End
End
Begin TextBox
OldBorderStyle =1
OverlapFlags =85
IMESentenceMode =3
Left =4260
Top =3600
Width =1260
TabIndex =15
BackColor =14741489
BorderColor =6180920
Name ="txtPhone"
GUID = Begin
0xb3954dad77893040b4da78d2c1747ac5
End
Begin
Begin Label
OverlapFlags =85
Left =3540
Top =3615
Width =585
Height =240
Name ="Label79"
Caption ="Phone"
GUID = Begin
0x3550577b620c5941a39e27ed9a41e412
End
End
End
End
Begin TextBox
OldBorderStyle =1
OverlapFlags =85
IMESentenceMode =3
Left =6240
Top =3600
TabIndex =16
BackColor =14741489
BorderColor =6180920
Name ="txtFax"
GUID = Begin
0x4c6585d95edec34fba7f613f2a3fc952
End
Begin
Begin Label
OverlapFlags =85
Left =5580
Top =3600
Width =585
Height =240
Name ="Label81"
Caption ="Fax"
GUID = Begin
0x6ece7db1be3bf44f98c2a9f410f8f320
End
End
End
End
Begin TextBox
OldBorderStyle =1
OverlapFlags =85
IMESentenceMode =3
Left =1380
Top =4005
Width =2400
TabIndex =17
BackColor =14741489
BorderColor =6180920
Name ="txtEmail"
GUID = Begin
0x185b61dbe7626345b92d81d2051e90ca
End
Begin
Begin Label
OverlapFlags =85
Left =240
Top =4020
Width =585
Height =240
Name ="Label83"
Caption ="Email"
GUID = Begin
0xf308657ef21a2a46a4d733d95e9cda35
End
End
End
End
Begin TextBox
OldBorderStyle =1
OverlapFlags =85
IMESentenceMode =3
Left =4620
Top =4005
Width =3060
TabIndex =18
BackColor =14741489
BorderColor =6180920
Name ="txtWebsite"
GUID = Begin
0x26cbf4ce5a564841b6983ee4cfc3ff17
End
Begin
Begin Label
OverlapFlags =85
Left =3840
Top =4020
Width =660
Height =240
Name ="Label85"
Caption ="Website"
GUID = Begin
0x9f09a82d6f9cda4fac195bf9d45bfaf8
End
End
End
End
Begin ComboBox
OldBorderStyle =1
OverlapFlags =85
IMESentenceMode =3
ColumnCount =3
Left =3960
Top =3180
Width =1080
TabIndex =12
BoundColumn =1
BackColor =14741489
BorderColor =6180920
ColumnInfo ="\"\";\"\";\"\";\"\";\"\";\"\";\"10\";\"4\""
GUID = Begin
0x9b400d921c061e439b4ad6dc1b3f4486
End
Name ="txtStateProv"
RowSourceType ="Table/View/StoredProc"
RowSource ="dbo.tlkpStatesAbbrev"
ColumnWidths ="0;2880;0"
Begin
Begin Label
OverlapFlags =85
Left =3000
Top =3195
Width =855
Height =240
Name ="Label73"
Caption ="State/Prov"
GUID = Begin
0x307b516824cf0448b9d4ffd1ad9f1504
End
End
End
End
Begin Label
OverlapFlags =85
Left =240
Top =1740
Width =3360
Height =210
Name ="Label86"
Caption ="Primary Address Information (optional)"
GUID = Begin
0x91a017a1bbad724cb54062329d2a611f
End
End
Begin ComboBox
OldBorderStyle =1
OverlapFlags =85
IMESentenceMode =3
Left =1380
Top =3600
Width =1980
TabIndex =14
BackColor =14741489
BorderColor =6180920
ColumnInfo ="\"\";\"\";\"10\";\"50\""
GUID = Begin
0x8ec0a6b6fa02764fad920b7c869909fe
End
Name ="txtCountry"
RowSourceType ="Table/View/StoredProc"
RowSource ="dbo.tlkpCountry"
Begin
Begin Label
OverlapFlags =85
Left =240
Top =3615
Width =660
Height =240
Name ="Label77"
Caption ="Country"
GUID = Begin
0xc3302fd98c97b64bb9e96709d107e6da
End
End
End
End
Begin ComboBox
OldBorderStyle =1
OverlapFlags =85
IMESentenceMode =3
Left =1380
Top =2100
Width =1980
TabIndex =8
BackColor =14741489
BorderColor =6180920
ColumnInfo ="\"\";\"\";\"10\";\"50\""
GUID = Begin
0xf78d78ac2160ef4fad7e19306c1ba15c
End
Name ="txtAddressType"
RowSourceType ="Table/View/StoredProc"
RowSource ="dbo.tlkpAddressType"
Begin
Begin Label
OverlapFlags =85
Left =240
Top =2115
Width =1065
Height =240
Name ="Label88"
Caption ="Address Type"
GUID = Begin
0xe652e5ba74df91428fc14cb14af941fe
End
End
End
End
End
End
Begin FormFooter
Visible = NotDefault
Height =855
BackColor =12632245
Name ="FormFooter"
GUID = Begin
0x339a63b6414fe44da10b8941f93f898e
End
End
End
End
CodeBehindForm
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Compare Database

Private Sub cmbContactType_AfterUpdate()
'reset all values on the form
Me!txtFamilyName.Value = ""
Me!txtOrganizationName.Value = ""
Me!cmbNamePrefix.Value = ""
Me!txtNameFirst.Value = ""
Me!txtNameMiddle.Value = ""
Me!txtNameLast.Value = ""
Me!cmbNameSuffix.Value = ""
'show/hide fields based on the contact type chosen
Select Case cmbContactType.Value
Case "Individual"
Me!txtFamilyName.Visible = False
Me!txtOrganizationName.Visible = False
Me!cmbNamePrefix.Visible = True
Me!txtNameFirst.Visible = True
Me!txtNameMiddle.Visible = True
Me!txtNameLast.Visible = True
Me!cmbNameSuffix.Visible = True
Case "Family"
Me!txtFamilyName.Visible = True
Me!txtOrganizationName.Visible = False
Me!cmbNamePrefix.Visible = False
Me!txtNameFirst.Visible = False
Me!txtNameMiddle.Visible = False
Me!txtNameLast.Visible = False
Me!cmbNameSuffix.Visible = False
Case "Organization"
Me!txtFamilyName.Visible = False
Me!txtOrganizationName.Visible = True
Me!cmbNamePrefix.Visible = False
Me!txtNameFirst.Visible = False
Me!txtNameMiddle.Visible = False
Me!txtNameLast.Visible = False
Me!cmbNameSuffix.Visible = False
End Select
End Sub

Private Sub cmdAddContactFromContext_Click()
Dim lngNewContactID As Long
Dim strSortName As String
Dim strContactName As String
Dim cmd As ADODB.Command
Dim prmrecordtype As ADODB.Parameter
Dim prmprefix As ADODB.Parameter
Dim prmfirst As ADODB.Parameter
Dim prmmid As ADODB.Parameter
Dim prmlast As ADODB.Parameter
Dim prmsuffix As ADODB.Parameter
Dim prmnick As ADODB.Parameter
Dim prmsort As ADODB.Parameter
Dim prmcontactName As ADODB.Parameter
Dim prmcontactid As ADODB.Parameter
Dim prmIsDuplicate As ADODB.Parameter
Dim prmSortName As ADODB.Parameter
Dim prmFamilyName As ADODB.Parameter
Dim bolIsDuplicate As Boolean

Select Case Me!cmbContactType
Case "Individual"
'check that either first and last Name are filled out
If Len(Me!txtNameFirst & Me!txtNameLast & "") = 0 Then
MsgBox "Either the first or last Name for the individual must be entered.", vbOKOnly + vbInformation, "Add Individual Contact Record"
Exit Sub
End If
'construct a ContactName
strContactName = LTrim(Me!cmbNamePrefix & " " & Trim(RTrim(Me!txtNameFirst & " " & Me!txtNameMiddle) & " " & Me!txtNameLast)) _
& IIf(Not IsNull(Me!cmbNameSuffix), ", " & Me!cmbNameSuffix, "")
'construct a SortName
strSortName = Trim(Me!txtNameLast & IIf(Len(Me!txtNameLast & Me!txtNameMiddle) > 0 And Not IsNull(Me!txtNameLast), ", ", "") _
& Trim(Me!txtNameFirst & " " & Me!txtNameMiddle))
Call CheckSortNameForDuplicates(strSortName)
'insert the record
Set cmd = New ADODB.Command
With cmd
.ActiveConnection = CurrentProject.Connection
Set prmrecordtype = .CreateParameter("@recordtype", adVarWChar, adParamInput, 16, "Individual")
.Parameters.Append prmrecordtype
Set prmprefix = .CreateParameter("@prefix", adVarWChar, adParamInput, 14, Me!cmbNamePrefix)
.Parameters.Append prmprefix
Set prmfirst = .CreateParameter("@Namefirst", adVarWChar, adParamInput, 20, Me!txtNameFirst)
.Parameters.Append prmfirst
Set prmmid = .CreateParameter("@midName", adVarWChar, adParamInput, 20, Me!txtNameMiddle)
.Parameters.Append prmmid
Set prmlast = .CreateParameter("@lastName", adVarWChar, adParamInput, 28, Me!txtNameLast)
.Parameters.Append prmlast
Set prmsuffix = .CreateParameter("@suffix", adVarWChar, adParamInput, 20, Me!cmbNameSuffix)
.Parameters.Append prmsuffix
Set prmnick = .CreateParameter("@nickName", adVarWChar, adParamInput, 20, "")
.Parameters.Append prmnick
Set prmsort = .CreateParameter("@sortName", adVarWChar, adParamInput, 100, strSortName)
.Parameters.Append prmsort
Set prmcontactName = .CreateParameter("@contactName", adVarWChar, adParamInput, 100, strContactName)
.Parameters.Append prmcontactName
Set prmcontactid = .CreateParameter("@contactid", adInteger, adParamOutput)
.Parameters.Append prmcontactid
.CommandText = "dbo.spInsertContactIndividual"
.CommandType = adCmdStoredProc
.Execute
End With
Case "Family"
strSortName = Me!txtFamilyName
Call CheckSortNameForDuplicates(strSortName)
Set cmd = New ADODB.Command
With cmd
.ActiveConnection = CurrentProject.Connection
Set prmrecordtype = .CreateParameter("@recordtype", adVarWChar, adParamInput, 16, "Family")
.Parameters.Append prmrecordtype
Set prmsort = .CreateParameter("@sortName", adVarWChar, adParamInput, 100, strSortName)
.Parameters.Append prmsort
Set prmcontactName = .CreateParameter("@contactName", adVarWChar, adParamInput, 100, Me!txtFamilyName)
.Parameters.Append prmcontactName
Set prmFamilyName = .CreateParameter("@familyname", adVarWChar, adParamInput, 100, Me!txtFamilyName)
.Parameters.Append prmFamilyName
Set prmcontactid = .CreateParameter("@contactid", adInteger, adParamOutput)
.Parameters.Append prmcontactid
.CommandText = "dbo.spInsertContactFamilyOrg"
.CommandType = adCmdStoredProc
.Execute
End With
Case "Organization"
strSortName = Me!txtOrganizationName
Call CheckSortNameForDuplicates(strSortName)
Set cmd = New ADODB.Command
With cmd
.ActiveConnection = CurrentProject.Connection
Set prmrecordtype = .CreateParameter("@recordtype", adVarWChar, adParamInput, 16, "Organization")
.Parameters.Append prmrecordtype
Set prmsort = .CreateParameter("@sortName", adVarWChar, adParamInput, 100, strSortName)
.Parameters.Append prmsort
Set prmcontactName = .CreateParameter("@contactName", adVarWChar, adParamInput, 100, Me!txtOrganizationName)
.Parameters.Append prmcontactName
Set prmFamilyName = .CreateParameter("@familyname", adVarWChar, adParamInput, 100, "")
.Parameters.Append prmFamilyName
Set prmcontactid = .CreateParameter("@contactid", adInteger, adParamOutput)
.Parameters.Append prmcontactid
.CommandText = "dbo.spInsertContactFamilyOrg"
.CommandType = adCmdStoredProc
.Execute
End With
End Select
lngNewContactID = prmcontactid.Value
'Add record to tblContactLocations
Dim prmaddresstype As ADODB.Parameter
Dim prmaddressline1 As ADODB.Parameter
Dim prmaddressline2 As ADODB.Parameter
Dim prmcity As ADODB.Parameter
Dim prmstate As ADODB.Parameter
Dim prmzip As ADODB.Parameter
Dim prmcountry As ADODB.Parameter
Dim prmphone As ADODB.Parameter
Dim prmfax As ADODB.Parameter
Dim prmemail As ADODB.Parameter
Dim prmwebsite As ADODB.Parameter
Dim prmpcl As ADODB.Parameter

Set cmd = New ADODB.Command
With cmd
.ActiveConnection = CurrentProject.Connection
Set prmaddresstype = .CreateParameter("@addresstype", adVarWChar, adParamInput, 50, Me!txtAddressType)
.Parameters.Append prmaddresstype
Set prmaddressline1 = .CreateParameter("@addressline1", adVarWChar, adParamInput, 100, Me!txtAddressLine1)
.Parameters.Append prmaddressline1
Set prmaddressline2 = .CreateParameter("@addressline2", adVarWChar, adParamInput, 100, Me!txtAddressLine2)
.Parameters.Append prmaddressline2
Set prmcity = .CreateParameter("@city", adVarWChar, adParamInput, 50, Me!txtCity)
.Parameters.Append prmcity
Set prmstate = .CreateParameter("@state", adVarWChar, adParamInput, 50, Me!txtStateProv)
.Parameters.Append prmstate
Set prmzip = .CreateParameter("@zip", adVarWChar, adParamInput, 50, Me!txtPostalCode)
.Parameters.Append prmzip
Set prmcountry = .CreateParameter("@country", adVarWChar, adParamInput, 50, Me!txtCountry)
.Parameters.Append prmcountry
Set prmphone = .CreateParameter("@phone", adVarWChar, adParamInput, 50, Me!txtPhone)
.Parameters.Append prmphone
Set prmfax = .CreateParameter("@fax", adVarWChar, adParamInput, 50, Me!txtFax)
.Parameters.Append prmfax
Set prmemail = .CreateParameter("@email", adVarWChar, adParamInput, 100, Me!txtEmail)
.Parameters.Append prmemail
Set prmwebsite = .CreateParameter("@website", adVarWChar, adParamInput, 100, Me!txtWebsite)
.Parameters.Append prmwebsite
Set prmcontactid = .CreateParameter("@contactid", adInteger, adParamInput, , lngNewContactID)
.Parameters.Append prmcontactid
Set prmpcl = .CreateParameter("@pcl", adBoolean, adParamInput, , 1)
.Parameters.Append prmpcl
.CommandText = "dbo.spCustom_FNDRSG_InsertIntoTblContactLocations"
.CommandType = adCmdStoredProc
.Execute
End With

Call MsgBox("Contact added to the database", vbOKOnly, "Contact Added")
Call AddValueToForm(prmcontactid.Value)
Call DoCmd.Close(acForm, "frmCustom_FNDRSG_AddContactContext", acSaveNo)
Set cmd = Nothing
End Sub

Private Sub cmdCancel_Click()
Call DoCmd.Close(acForm, "frmCustom_FNDRSG_AddContactContext", acSaveNo)
End Sub

Private Function CheckSortNameForDuplicates(strSortName As String)
'check to see if the contact's sort name already exists
Dim cmd As New ADODB.Command
Set cmd = New ADODB.Command
With cmd
.ActiveConnection = CurrentProject.Connection
Set prmSortName = .CreateParameter("@sortname", adVarWChar, adParamInput, 200, strSortName)
.Parameters.Append prmSortName
Set prmIsDuplicate = .CreateParameter("@isdup", adBoolean, adParamOutput)
.Parameters.Append prmIsDuplicate
.CommandText = "dbo.spCustom_FNDRSG_ContactIsDup"
.CommandType = adCmdStoredProc
.Execute
End With
bolIsDuplicate = prmIsDuplicate.Value
If bolIsDuplicate = True Then
If MsgBox("A contact with the sort name '" & strSortName & "' already exists in the database. Would you like to add this contact anyway?", vbYesNo, "Add Contact Anyway?") = vbNo Then
Exit Function
End If
End If
End Function
Site powered by a free Open Source Project / Non-profit License (more) of Confluence - the Enterprise wiki.
Learn more or evaluate Confluence for your organisation.
Powered by Atlassian Confluence, the Enterprise Wiki. (Version: 2.1.1 Build:#406 Dec 23, 2005) - Bug/feature request - Contact Administrators