Dim session As New NotesSession
Dim db As NotesDatabase
Set db = session.currentdatabase
Dim contactdoc As NotesDocument
Dim actview As NotesView
Set actview = db.GetView("luByActId")
Dim ACTId As String
Dim appflag As Boolean
'check and see if they want to specify the .dbf file to import, or
they have only one file which the system will find.
If Messagebox("Do you have more than 1 ACT Database to import?",
MB_YESNO + MB_ICONQUESTION) = IDYES Then
FileName = OpenCommDlg
Set objDatabase = CreateObject("ACTOLE.DATABASE")
objDatabase.Open FileName
Else
Set objApplication = CreateObject("ACTOLE.APPOBJECT")
Set objDatabase = CreateObject("ACTOLE.DATABASE")
objDatabase.Open objApplication.GetOpenDBName
objApplication.Minimize
appflag = True
End If
If objDatabase.IsMultiUser Then
Dim username As String
Dim password As String
username = Inputbox("Please Enter a User Name")
password = Inputbox("Please Enter a Password")
objDatabase.validateuser username, password
End If
Dim counter As Long
counter = 0
Dim pp As Integer
If objDatabase.IsOpen Then
Set objContact = objDatabase.CONTACT
If objContact.recordCount > 0 Then
objContact.MoveFirst
While Not objContact.IsEOF
If objContact.Data(CF_PublicPrivate) = 1 Then
counter = counter + 1
Print "Importing Record " & counter & " of " objContact.recordCount
ACTId = objContact.Data(CF_UniqueID)
Set contactdoc = actview.GetDocumentByKey(ACTId, True)
If contactdoc Is Nothing Then
Set contactdoc = db.createdocument()
contactdoc.ACTUniqueID = objContact.Data(CF_UniqueID)
End If
contactdoc.Form = "Prospect"
contactdoc.ContactStatus = "Prospect"
contactdoc.CompanyName = objContact.Data(CF_Company)
contactdoc.ContactName = objContact.Data(CF_Name)
contactdoc.ContactTitle = objContact.Data(CF_Title)
contactdoc.ContactDepartment = objContact.Data(CF_Department)
contactdoc.ContactPhoneOffice = objContact.Data(CF_Phone)
contactdoc.ContactPhoneFax = objContact.Data(CF_Fax)
contactdoc.ContactPhoneCell =objContact.Data(CF_MobilePhone)
contactdoc.ContactSalutation = objContact.Data(CF_Salutation)
contactdoc.WebSite = objContact.Data(CF_URL)
contactdoc.CompanyAddressL1 = objContact.Data(CF_Address1)
contactdoc.CompanyAddressL2 = objContact.Data(CF_Address2)
contactdoc.CompanyAddressL3 = objContact.Data(CF_Address3)
contactdoc.CompanyCity = objContact.Data(CF_City)
contactdoc.CompanyState = objContact.Data(CF_State)
contactdoc.CompanyZip = objContact.Data(CF_Zip)
contactdoc.CompanyCountry = objContact.Data(CF_Country)
contactdoc.ContactEmail = objContact.Data(CVF_EmailAddress)
Call contactdoc.save(True,True)
End If
objContact.MoveNext
Wend
End If
Set objContact = Nothing
objDatabase.Close
If appflag Then
objApplication.CloseDB
End If
End If
End Sub
|
|
