Ситуация в следующем, есть непрерывно работающий макрос по парсингу вебстраницы (регулярные запросы на сайт, извлечение в виде текста, и в случае поступления новой информации на этом сайте, передаче этой новой информации в группу телеграмм), иногда рандомно может 1 раз в сутки или 1 раз в 4-5 часов выскакивает ошибка " vba excel 91 object variable or with block variable not set" в строке помеченной в коде ниже и выполнение макроса соответственно останавливается что есть очень плохо так как я не могу постоянно отслеживать эту ошибку. Может есть мысли в чем причина?.P.S прошу не судить строго по коду, слепил из того что нашел в сети
Код |
---|
Public Function EncodeUTF8(str As String) Dim ScriptEngine As Object Set ScriptEngine = CreateObject("ScriptControl") ScriptEngine.Language = "JScript" EncodeUTF8 = ScriptEngine.Run("encodeURIComponent", str) End Function Function getText(ByRef url As String) As String With CreateObject("MSXML2.XMLHTTP") .Open "GET", url, False .send Null getText = .responseText End With End Function Sub Test() Dim myFile As Object, myTag As Object Dim pageText As String, Message As String Const url As String = "https://mob.della.ua/results/?geo=a164bdeflolh6k0m" Dim Data As String, marshrut As String, gruz As String, fraht As String Application.OnTime Now + TimeValue("00:00:05"), "test" pageText = getText(url) Set myFile = CreateObject("HTMLFile") myFile.body.innerHTML = pageText Set myTag = myFile.getElementsByTagName("td") Data = myTag(6).innerText '6 дата ВОТ ЗДЕСЬ И ВЫСКАКИВАЕТ ОШИБКА!!!, если убрать переменную Дата, то будет уже ошибка в след. в marshrut Data = Data + " " marshrut = myTag(7).innerText '7 маршрут marshrut = marshrut + " " gruz = myTag(9).innerText '9 груз gruz = gruz + " " fraht = myTag(10).innerText '10 фракт fraht = fraht + " " txt$ = Data & marshrut & gruz & fraht & url If txt$ <> [A5] Then [A5] = txt$ Else End Message = [A5] Message = EncodeUTF8(Message) sURI = "https://api.telegram.org/bot5036799064:AAEWVM0WlYPDyWLJobanFv47FKv_D-YUFd8/sendMessage?chat_id=-1001707707704&text=" & Message On Error Resume Next Set oHttp = CreateObject("WinHttp.WinHttpRequest.5.1") If Err.Number <> 0 Then Set oHttp = CreateObject("MSXML.XMLHTTPRequest") 'можно ли здесь "MSXML.XMLHTTPRequest" заменить на "MSXML2.XMLHTTP" ' т.к MSXML.XMLHTTPRequest не работает или у них разное назнаечение? End If On Error GoTo 0 If oHttp Is Nothing Then Exit Sub oHttp.Open "GET", sURI, False oHttp.send Set oHttp = Nothing End Sub |