Макросы в Excel

Function SetSelectElementValue(ByRef IEdoc As Object, _
                               ByVal SelectElementName$, ByVal NewValue$) As Boolean
    ' функция ищет в документе IEdoc (типа HTMLDocument) выпадающий список с именем SelectElementName$,
   ' и пытается установить его значение в NewValue$
   ' в случае ошибки выводит сообщение о невозможности установки нового значения
   ' Возвращает результат операции (TRUE, если всё прошло успешно)

    On Error Resume Next: Err.Clear
    'Dim msComBox As HTMLSelectElement, msOption As HTMLOptionElement

    ' находим на веб-странице элемент с именем SelectElementName$
   Set msComBox = IEdoc.getElementsByName(SelectElementName$).Item(0)

    For Each msOption In msComBox    ' перебираем все опции в выпадающем списке
       ' формируем переменную txt, содержащую список опций (на случай ошибки функции)
       txt = txt & "Option" & msOption.Index & ": " & """" & msOption.Text & """" & vbNewLine

        If msOption.Text = NewValue$ Then    ' если текущая опция совпадает с нужной нам
           msComBox.selectedIndex = msOption.Index    ' активируем её
           msComBox.FireEvent ("onchange")    ' вызываем событие изменения значения
           SetSelectElementValue = True: Exit Function    ' выход из функции
       End If
    Next msOption

    ' если выполнение кода дошло до этого места - среди опций не оказалось варианта NewValue$
   ' получаем заголовок поля - текст вышестоящего элемента
   Label$ = msComBox.parentElement.innerText: Label$ = Split(Label$, ":")(0)
    ' формируем текст сообщения об ошибке
   msg = "Не удалось установить значение «" & NewValue$ & "»" & vbNewLine
    msg = msg & "в выпадающем списке «" & Label$ & "» (кодовое имя: «" & SelectElementName$ & "»)"
    msg = msg & vbNewLine & vbNewLine & "Список допустимых значений:" & vbNewLine & vbNewLine & txt
    MsgBox msg, vbExclamation, "Ошибка установки значения в выпадающем списке «" & Label$ & "»"
End Function

Function SendToWebsite(ByRef IE As Object) As Boolean
    ' функция публикации объявления о продаже недвижимости на сайте риэлторского агенства

    Set IE = New InternetExplorer    ' создаём объект InternetExplorer
   On Error Resume Next: Err.Clear
    IE.Navigate URL_main    ' переходим на нужную страницу
   ' ждём, пока страница загрузиться
   While IE.Busy Or (IE.ReadyState <> 4): DoEvents: Wend
    Set IEdoc = IE.Document: DoEvents    ' получаем ссылку на документ (веб-страницу)

    ' заполняем поля документа
   SetSelectElementValue IEdoc, "act", "Продам"
    SetSelectElementValue IEdoc, "type", ТипНедвижимости

    SetSelectElementValue IEdoc, "region", Город
    SetSelectElementValue IEdoc, "district", Район
    SetSelectElementValue IEdoc, "num_rooms", КоличествоКомнат

    SetInputElementValue IEdoc, "et_num", Этаж
    SetInputElementValue IEdoc, "et_max", Этажность

    SetSelectElementValue IEdoc, "house_kind", ВидДома
    SetSelectElementValue IEdoc, "house_type", ТипДома

    SetInputElementValue IEdoc, "addr", Адрес
    SetInputElementValue IEdoc, "s_total", ПлощадьОбщая
    SetInputElementValue IEdoc, "s_live", ПлощадьЖилая
    SetInputElementValue IEdoc, "s_kit", ПлощадьКухня

    SetInputElementValue IEdoc, "price", Цена

    SetOptionElementValue IEdoc, "has_bal", Балкон
    SetOptionElementValue IEdoc, "has_log", Лоджия
    SetOptionElementValue IEdoc, "has_lift", Лифт
    SetOptionElementValue IEdoc, "has_phone", Телефон

    SetInputElementValue IEdoc, "body", Comment

    ' производим отправку данных формы
   IEdoc.getElementsByName("add_form").Item(0).submit
    ' ждём, пока страница отправится, и загрузится новая
   While IE.Busy Or (IE.ReadyState <> 4): DoEvents: Wend
    SendToWebsite = Err = 0
End Function