РН. РосНефть — сходить на сайт и взять из списка структуру

Public Sub РосНефть_Структура_()
'Сходить на сайт и взять из списка структуру
    Dim str As String, strUrl As String, strProc_Name
 
    strUrl = "http://zakupki.rosneft.ru/zakupki"
    strProc_Name = "РосНефть_Структура"
 
    str = HTTP_getText(strUrl)
    If str = vbNullString Then MsgBox4Debug strUrl, strProc_Name
 
    Copy2ClipBoard Роснефть_Зачистка(str)
 
    Роснефть_Дизайн (str)
 
End Sub
 
Private Function Роснефть_Дизайн(str As String) As String
    Dim wb     As Workbook
    Set wb = Workbooks.Add
    Dim ws     As Worksheet
    Set ws = wb.Worksheets.Add(Type:=xlWorksheet)
 
    Dim Arr()  As String
    Arr = Split(str, vbCrLf)
 
    Dim arrNew() As String
    ReDim arrNew(UBound(Arr), 1)
 
    'подготовить для регионов = левый столбец будет пустой
    Dim iArrayForNext As Long
    For iArrayForNext = LBound(Arr) To UBound(Arr)
      arrNew(iArrayForNext, 1) = Arr(iArrayForNext)
    Next
 
    'Регионы заполнить
    For iArrayForNext = LBound(arrNew) To UBound(arrNew)
        РН_Регион_Проставить arrNew, iArrayForNext
        РН_Отсечь_Слева_по_Знак arrNew, iArrayForNext, ">"
    Next
 
    With ws
      .[a1].Value = "Регион"
      .[b1].Value = "РосНефти"
      .Range(.[a1], .[b1]).Font.Bold = True
      'Вставить массив на лист
      .[a2].Resize(UBound(arrNew), UBound(arrNew, 2) + 1) = arrNew
 
    End With
 
    Строки_Пустые_Удалить ws
End Function
 
Private Sub РН_Отсечь_Слева_по_Знак(ByRef arrNew, _
                                  ByVal iArrayForNext, _
                                  ByVal iSymb As String)
' из строк вида "46095>РН-Транспорт" сделать "РН-Транспорт"
 
  Dim Позиция As Long, iCol As Long, x As Long, str As String
 
  For iCol = LBound(arrNew, 2) To UBound(arrNew, 2)
    'по строкам проходит вызывающая процедура
      Позиция = InStr(arrNew(iArrayForNext, iCol), iSymb)
 
        If Позиция > 0 Then
          str = arrNew(iArrayForNext, iCol)
          arrNew(iArrayForNext, iCol) = Right$(str, Len(str) - Позиция)
        Else
        'ничего
        End If
    Next
End Sub
 
 
Private Sub РН_Регион_Проставить(ByRef arrNew, _
                                  ByVal iArrayForNext)
Dim Регион_Признак As String: Регион_Признак = " >"
 
If InStr(arrNew(iArrayForNext, 1), Регион_Признак) > 0 Then
  Dim x As Long, strРегин As String
 
    'заполняю от признака региона до следующего признака
    For x = iArrayForNext + 1 To UBound(arrNew)
      If InStr(arrNew(x, 1), Регион_Признак) > 0 Then
        Exit For '==>>
      Else
        'Вставить регион
        arrNew(x, 0) = arrNew(iArrayForNext, 1)
      End If
    Next
    ' очистить регион
    arrNew(iArrayForNext, 1) = vbNullString
Else
  ' Ничего не надо
End If
 
End Sub
 
Private Function Роснефть_Зачистка(str As String) As String
    str = extractBetween(str, ">Центральный ФО", "&quot;</option></select>")
 
    str = Replace(str, "&nbsp;", "")
 
    str = Replace(str, "</option><option value=" & Chr(34), vbCrLf)
    str = Replace(str, "&quot;", Chr(34))
    str = Replace(str, Chr(34), vbNullString)
    str = Replace(str, "ЗАО ", vbNullString)
    str = Replace(str, "ООО ", vbNullString)
    str = Replace(str, "ОАО ", vbNullString)
    str = Replace(str, "АО ", vbNullString)
    str = Replace(str, "«", vbNullString)
    str = Replace(str, "»", vbNullString)
    str = Replace(str, "> ", ">")
 
    Роснефть_Зачистка = str
End Function

Private Function extractBetween(ByRef txt As String, _
                                ByRef sLeft As String, _
                                ByRef sRight As String)
    extractBetween = ""    'извлечть между
    If Len(txt) > 0 And Len(txt) > 0 And Len(txt) > 0 And _
       InStr(txt, sLeft) > 0 And InStr(txt, sRight) > 0 Then
        Dim s
        s = Split(txt, sLeft)
        s = Split(s(1), sRight)
        extractBetween = s(0)
    Else
        'обработка ошибки
        Call MsgBox4Debug("Или пустые строки. Или нечего делить. Функция extractBetween не отработала ...", _
                          "Непорядок")
    End If
End Function