и отмеченной записью Dim pers
|
Public Sub WorkWithSelected() 'Обработка с выбранной и отмеченной записью Dim pers As Person, pars As Paragraphs, par As Paragraph Dim i As Integer, n As Integer Dim myR As Range Dim FirstWord As String Set pars = Selection.Paragraphs With pers 'Обработка первого абзаца - фамилии Set par = pars(1) Set myR = par.Range .FirstName = myR.Words(2).Text .MiddleName = myR.Words(3).Text .LastName = myR.Words(1).Text 'Обработка должности - следующего непустого абзаца Set par = pars(2) If par.Range.Words.Count = 1 Then Set par = pars(3) Set myR = par.Range n = myR.Words.Count myR.End = par.Range.Words(n - 1).End .Post = myR.Text 'Обработка оставшихся абзацев For Each par In pars Set myR = par.Range n = myR.Words.Count FirstWord = myR.Words(1).Text Select Case FirstWord Case "Родился ", "Родилась " .DOB = SelectDate(par.Range) Case "Тел" myR.Start = par.Range.Words(3).Start myR.End = par.Range.Words(n - 1).End .Tel = myR.Text Case "Факс" myR.Start = par.Range.Words(3).Start myR.End = par.Range.Words(n - 1).End .Fax = myR.Text Case "Адрес" myR.Start = par.Range.Words(3).Start myR.End = par.Range.Words(n - 1).End .Address = myR.Text Case "e" myR.Start = par.Range.Words(5).Start myR.End = par.Range.Words(n - 1).End .Email = myR.Text Case Else .Other = .Other + myR.Text End Select Next par If Not IsDate(.DOB) Then .DOB = "1 января " 'Debug.Print Selection.Range.Text 'Debug.Print .FIO, .Post, .Address, .DOB, .Tel, .Fax, .Email, .Other End With 'Запись создана - теперь создается контакт в Outlook Call WriteToContact(pers) End Sub |
| Листинг 2.32. |
| Закрыть окно |
