Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Прикрутить к VBA api antigate, для распознавания капчи?
 
Кто-нибудь пытался прикрутить к VBA api  antigate, для распознавания капчи?
Вот тут по ссылке даны api
(для показа нужна авторизация)
https://anticaptcha.atlassian.net/wiki/spaces/API/pages/578453521/API

Там перечислены методы

Цитата
Метод создает задачу на решение выбранного типа капчи. В параметрах передаются авторизационные данные клиента, типизированные данные задачи и другие необязательные параметры.

Адрес метода: https://api.anti-captcha.com/createTask
Формат запроса: JSON POST
Я так понимаю
Это HTTP запросы. Как их реализовать в vba?
Заменить ссылки на ячейки в формуле на значения, Конвертация формул
 
Цитата
Александр написал: Просто интересно, для чего?
При расчете надо формулу вывести.  Ведомость объма работ в строительстве

Цитата
Ігор Гончаренко написал: нужно тупо парсить элегантным макросом
Эх, а я думал есть функция заветная, чтобы фи-и-ить! и всё!...
Заменить ссылки на ячейки в формуле на значения, Конвертация формул
 
Столкнулся, внезапно, с одной задачей. В ячейке есть формула, в стиде  ссылок R1C1 вида
Код
=ОКРУГЛ(R[-10]C*RC[1];2)

Надо заменить ссылки значениями из этих ячеек, чтобы получить формулу вида
Код
=ОКРУГЛ(42,85*0,6;2)

Есть какое-нибудь элегантное решение, или придется тупо парсить строку?
Искажение кодировки при копировании текста макроса из окна VBA, 'Çíà÷åíèå èíäåêñà ìàêñèìàëüíîãî ýëåìååíòà ìàññèâà
 
Через раз при копировании текста макроса в другую программу, выводит "гречку". Смущает то, что это происходит не постоянно, а от разу... Есть способ это побороть?
Код
Sub macro4()

'tablica jednowymiarowa zawieraj¹ca 10 komórek
Dim tablica(1 To 10) As Single


For i = 1 To 10
    tablica(i) = Math.Round(Math.Rnd(10), 2) 'Îêðóãëÿåì çíà÷åíèÿ äî äâóõ çíàêîâ ïîñëå çàïÿòîé
    Worksheets("Arkuszl").Range("C" & i) = "Liczba nr. " & i & ")=" & tablica(i)
Next i
    
Max_ind = 1  'Çíà÷åíèå èíäåêñà ìàêñèìàëüíîãî ýëåìååíòà ìàññèâà
Min_ind = 1 'Çíà÷åíèå èíäåêñà ìèíèìàëüíîãî ýëåìååíòà ìàññèâà
Max_val = tablica(1) 'Ïåðâîå ïðèáëèæåíèå ìàêñèìóì - ïåðâûé ýëåìåíò ìàññèâà
Min_val = tablica(1) 'Ïåðâîå ïðèáëèæåíèå ìèíèìóì - ïåðâûé ýëåìåíò ìàññèâà
    

'Ìàññèâ ïðîñìàòðèâàåì ñî âòîðîãî ýëåìåíòà
For i = 2 To 10
    
    If Max_val < tablica(i) Then
        Max_val = tablica(i)
        Max_ind = i
    End If
    
    If Min_val > tablica(i) Then
        Min_val = tablica(i)
        Min_ind = i
    End If

Next i
    
'Âûâîäèì íà ñòðàíèöó çíà÷åíèå ìàêñèìóìà è ìèíèìóìà è åãî èíäåêñ
Worksheets("Arkuszl").Range("C11") = "Min val." & Min_ind & " = " & Min_val
Worksheets("Arkuszl").Range("C12") = "Max val." & Max_ind & " = " & Max_val
    
    'Ñîðòèðîâêà ìàññèâà
    
    For j = 1 To 10
    'Ïðèðàâíèâàåì ïåðâûé ýëåìåíò èç îñòàâøåéñÿ ïîñëåäîâàòåëüíîñòè ìèíèìàëüíîìó, è èíäåêñ
    Min_val = tablica(j)
    Min_ind = j
    For i = j + 1 To 10 'Ïðîñìàòðèâàåì îñòàâøèóþñÿ ïîñëåäîâàòåëüíîñòü
   
    'Íàõîäèì ìàêñèìàëüíûé ýëåìåíò è çàïîìèíàåì åãî èíäåêñ
    If Min_val > tablica(i) Then
        Min_val = tablica(i)
        Min_ind = i
    End If
    Next i
    
    'Ìåíÿåì ýëåìåíòû ìâññèâà ìåñòàìè è âûâîäèì íà ñòðàíèöó
        p = tablica(j)
        tablica(j) = Min_val
        tablica(Min_ind) = p

    Worksheets("Arkuszl").Range("C" & (j + 15)) = "Liczba nr. " & j & ")=" & tablica(j)
Next j
    
 End Sub
Работа с Яндекс диском из vba, Загрузить файл, скачать, создать директорию, переименовать
 
Решение оригинальное, но при этом очень длго происходит подключение и отключение. Здесь надо, всё-таки использовать HTTP-запросы.
Работа с Яндекс диском из vba, Загрузить файл, скачать, создать директорию, переименовать
 
По теме нашел две ссылки, странно, но почему-то ни для vbscript, ни для  vba примеры не находятся.
http://www.excelworld.ru/forum/10-31426-1
И вот здесь еще были примеры
http://hiprog.com/access/dwn/WebdavYandexDisk.zip

В документации написано, что надо зарегистрировать приложение в https://oauth.yandex.ru/
Тогда будет токен и id

В api Яндекс диск дан пример запроса на загрузку
Код
Пример запроса
Приложение загружает файл otpusk.avi в каталог /a/ на Диске пользователя, указывая контрольную сумму и хэш для проверки дубликатов.PUT /a/otpusk.avi HTTP/1.1
Host: webdav.yandex.ru
Accept: */*
Authorization: OAuth 0c4181a7c2cf4521964a72ff57a34a07
Etag: 1bc29b36f623ba82aaf6724fd3b16718
Sha256: T8A8H6B407D7809569CA9ABCB0082E4F8D5651E46D3CDB762D02D0BF37C9E592
Expect: 100-continue
Content-Type: application/binary
Content-Length: 103134024
Я так понимаю изменили авторизацию и теперь для авторизации нужен только токен

Адаптировал процедуру
Код
Private Function Str2Byte(str$) As Byte()
    Str2Byte = StrConv(str, vbFromUnicode)
End Function
Private Function urlencode$(url)
    With CreateObject("scriptcontrol")
        .Language = "JavaScript"
        urlencode = .eval("encodeURI('" & url & "')")
    End With
End Function
Private Function MD5(ByVal bytes) As String
    Dim sTmp$, i%, byteArr() As Byte
    byteArr = bytes
    With CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
        byteArr = .ComputeHash_2(byteArr)
    End With
    For i = 0 To UBound(byteArr)
        sTmp = sTmp & LCase(Right("0" & Hex(byteArr(i)), 2))
    Next
    MD5 = sTmp
End Function
Private Function Sha256(ByVal bytes) As String
    Dim sTmp As String
    Dim i As Integer
    Dim byteArr() As Byte
    byteArr = bytes
    With CreateObject("System.Security.Cryptography.SHA256Managed")
        byteArr = .ComputeHash_2(byteArr)
    End With
    For i = 0 To UBound(byteArr)
        sTmp = sTmp & LCase(Right("0" & Hex(byteArr(i)), 2))
    Next
    Sha256 = sTmp
End Function

Public Sub ÇàãðóçêàÔàéëà()
    Dim FileContents As Variant
    Dim FileName As String
    Dim stream As Object
    Dim http As Object
    Dim LocalFilePath As String
    Dim RemotePath As String
    
    LocalFilePath = "c:\#work\777(minus).mp3"
    RemotePath = "777.mp3"
    
    Host_disk = "https://webdav.yandex.ru/"
    RemotePath = Host_disk & RemotePath & "/"
    api_token = "e8cdc14be1604caeb4d2aac960a6027c"
    id_token = "e8cdc14be1604caeb4d2aac960a6027c"
        
    Set stream = CreateObject("ADODB.Stream")
    
    With stream
      .Type = 1
        .Open
        .LoadFromFile LocalFilePath
        FileContents = .Read
        .Close
    End With
    
    Set http_disk = CreateObject("WinHttp.WinHttpRequest.5.1")
    With http_disk
        .Open "PUT", urlencode(RemotePath)
        .setRequestHeader "Host", "webdav.yandex.ru"
        .setRequestHeader "Accept", "*/*"
        .setRequestHeader "Etag", MD5(FileContents)
        .setRequestHeader "Sha256", Sha256(FileContents)
        .setRequestHeader "Expect", "100-continue"
        .setRequestHeader "Content-Type", "application/binary"
         
         Êëþ÷ = "oauth_token=" & Chr(34) & api_token & Chr(34)
         Êëþ÷1 = " oauth_client_id=" & Chr(34) & id_token & Chr(34)
        
        
        .setRequestHeader "Authorization", "OAuth " & Êëþ÷, Êëþ÷1
        .setRequestHeader "Content-Length", UBound(FileContents) + 1
        .send FileContents
        .WaitForResponse
        Debug.Print .StatusText
    End With
End Sub

Возвращает статус
Цитата
401          
Unauthorized
В запросе не указаны авторизационные данные.
https://tech.yandex.ru/market/partner/doc/dg/concepts/authorization-docpage/
Написано вот что надо в запросе указывать
Authorization: OAuth oauth_token="авторизационный_токен", oauth_client_id="идентификатор_приложения"

Что не так?
Использование регулярных выражений в Vba Подключение библитотеки, Ошибка при выполнении метода Execute
 
В примерах на JavaScript
Код
var data = 'тут текст какой-то <weneeditatt>надо вытянуть</weneeditatt>'
var nov_reg = "<weneeditatt>(.*)</weneeditatt>";
var myAttr = data.match(nov_reg);
и на Autotoit
Код
#include <MsgBoxConstants.au3>
#include <StringConstants.au3>
 
Local $aArray = 0,  $iOffset = 1
While 1
    $aArray = StringRegExp('<test>a</test> <test>b</test> <test>c</Test>', '(?i)<test>(.*?)</test>', $STR_REGEXPARRAYMATCH, $iOffset)
    If @error Then ExitLoop
    $iOffset = @extended
    For $i = 0 To UBound($aArray) - 1
        MsgBox($MB_SYSTEMMODAL, "RegExp Test with Option 1 - " & $i, $aArray[$i])
    Next
WEnd

Значением возвращаемым функцией является массив элементов с учетом круглых (как их в литературе называют "жадных") скобок. И только в реализации регулярных выражений от Microsoft, возвращается еще и коллекция включающая граничные фрагменты текста. По сути объект содержит ДВЕ коллекции. Это оригинально. На мой взгляд. Впрочем те, кто начал свое знакомство с регулярными выражениями с продукта Microsoft, тот так не считает, вполне допускаю.
Использование регулярных выражений в Vba Подключение библитотеки, Ошибка при выполнении метода Execute
 
Цитата
Казанский написал:
vcomp71 , про SubMatches Вам написали уже в #5 и #8. Все не впрок.
Ну это оригинальное решение, кончено. Я имею в виду Microsoft...
Использование регулярных выражений в Vba Подключение библитотеки, Ошибка при выполнении метода Execute
 
Так и сделал. Вот кусок кода из моего примера
Код
myRegExp.Pattern = "<test>(.*?)</test>" ' øàáëîí äëÿ ïîèñêà
Всё равно пришлось дорабатывать напильноком с помощью функции mid
Использование регулярных выражений в Vba Подключение библитотеки, Ошибка при выполнении метода Execute
 
Аалогичный фрагмент с сайта по Java
Код
var data = 'тут текст какой-то <weneeditatt>надо вытянуть</weneeditatt>'
var nov_reg = "<weneeditatt>(.*)</weneeditatt>";
var myAttr = data.match(nov_reg);
Получает текст ИСКЛЮЧАЯ
<weneeditatt> и  </weneeditatt>

Пишут "Нужно оборачивать искомую часть регулярки в скобочки." в VBA так не получается, результат запроса текст ВКЛЮЧАЕТ ограничивающие выражения?

Возвращаясь к моему примеру


Можно потом "доработать напильником" с помощью функции mid,
Код
Sub RegExp_exemple()

Dim myRegExp As New RegExp ' ñîçäàåì ýêçåìïëÿð RegExp
Dim aMatch As Match ' îäèí èç ñîâïàâøèõ îáðàçöîâ
Dim colMatches As MatchCollection ' êîëëåêöèÿ ýòèõ îáðàçöîâ
Dim strTest As String ' òåñòèðóåìàÿ ñòðîêà

strTest = "<test>À âîò òóò òåêñò</test> <test>b</test> <test>c</test>"

' óñòàíàâëèâàåì ñâîéñòâà îáúåêòà RegExp
myRegExp.Global = True ' åñëè Global = True, òî ïîèñê âåä¸òñÿ âî âñåé ñòðîêå, _
åñëè False, òî òîëüêî äî ïåðâîãî ñîâïàäåíèÿ
myRegExp.IgnoreCase = True ' èãíîðèðîâàòü ðåãèñòð ñèìâîëîâ ïðè ïîèñêå

myRegExp.Pattern = "<test>(.*?)</test>" ' øàáëîí äëÿ ïîèñêà

Set colMatches = myRegExp.Execute(strTest) ' ïîëó÷àåì êîëëåêöèþ ñîâïàäåíèé ñ îáðàçöîì
'Set colMatches = myRegExp.Test(strTest)
'ïåðåáèðàåì êîëëåêöèþ è ïðîñìàòðèâàåì ðåçóëüòàòû
For Each aMatch In colMatches ' ïðîõîäèì ïî âñåé êîëëåêöèè
a = aMatch.FirstIndex ' ïîðÿäêîâûé íîìåð ïåðâîãî ñèìâîëà íàéäåííîãî îáðàçöà
b = aMatch.Length ' êîë-âî ñèìâîëîâ â íàéäåííîì îáðàçöå
c = aMatch.Value ' ïîëíûé îáðàçåö

Старт = Len("<test>")
Длина = Len(c)
Конец = Len("/<test>")
c = Mid(c, Страт + 1, Длина - Старт - Конец)

Next aMatch

Debug.Print c

End Sub
Тогда получается искомый текст
но принципиально интересно как это сделать с регулярными выражениями.
Изменено: vcomp71 - 19 Сен 2018 08:34:10
Использование регулярных выражений в Vba Подключение библитотеки, Ошибка при выполнении метода Execute
 
Цитата
Ігор Гончаренко написал:
удалите из начала шаблона это: (?i)могу Вас поздравить! Вам удалось составить шаблон, который завалил RegExp!!!
Текст шаблона взят из помощи по autoit это скриптовый яжык. Там такой шаблон прекрасно работает!


Код
#include <MsgBoxConstants.au3>
#include <StringConstants.au3>

Local $aArray = 0, _
        $iOffset = 1
While 1
    $aArray = StringRegExp('<test>a</test> <test>b</test> <test>c</Test>', '(?i)<test>(.*?)</test>', $STR_REGEXPARRAYMATCH, $iOffset)
    If @error Then ExitLoop
    $iOffset = @extended
    For $i = 0 To UBound($aArray) - 1
        MsgBox($MB_SYSTEMMODAL, "RegExp Test with Option 1 - " & $i, $aArray[$i])
    Next
WEnd


Это было для исключения из результатов самой маски, то есть  результат работы скрипта  - соллекция из назначий текста заключенного в тегах
Код
"<test>a</test> <test>b</test> <test>c</Test>"

результат:

'a'
'b'
'c'

А в Vba возвращает
<test>a</test>

АР последующие  вкючения не находятся...
Изменено: vcomp71 - 17 Сен 2018 13:05:02
Использование регулярных выражений в Vba Подключение библитотеки, Ошибка при выполнении метода Execute
 
Воспользовался примером для тастирования регулярных выражений
Код
Sub RegExp_exemple()

Dim myRegExp As New RegExp ' создаем экземпляр RegExp
Dim aMatch As Match ' один из совпавших образцов
Dim colMatches As MatchCollection ' коллекция этих образцов
Dim strTest As String ' тестируемая строка

strTest = "<test>a</test> <test>b</test> <test>c</Test>"

' устанавливаем свойства объекта RegExp
myRegExp.Global = False ' если Global = True, то поиск ведётся во всей строке, _
если False, то только до первого совпадения
myRegExp.IgnoreCase = True ' игнорировать регистр символов при поиске
myRegExp.Pattern = "(?i)<test>(.*?)</test>" ' шаблон для поиска
Set colMatches = myRegExp.Execute(strTest) ' получаем коллекцию совпадений с образцом
'перебираем коллекцию и просматриваем результаты
For Each aMatch In colMatches ' проходим по всей коллекции
a = aMatch.FirstIndex ' порядковый номер первого символа найденного образца
b = aMatch.Length ' кол-во символов в найденном образце
c = aMatch.Value ' полный образец
Next aMatch

Debug.Print c

End Sub
Подключил библиотеку


При выполнении выдает ошибку.



Пробовал на другой системе, думал, что просто на компьютере какой-то сбой с регистрацией соотвествующей билиотеки, нет тоже самое. В чем может быть дело?

Пробовал менять текст и маску для поиска
Изменено: vcomp71 - 17 Сен 2018 09:14:12
Извлечение атрибутов из значения тэга HTML, Как получить дополнительные занчения атрибутов
 
Спасибо! Сдлал все как написали! Действительно, ошибся, с помощью конструкции  
Код
Set oElements = oHtml.getElementsByClassName("user-comment-item")
Мы получаем коллекцию.
Длаьше для перебора коллекции воспользовался
Код
For Each oElement In oElements
next
но ваот какой случился казус... Выбрал другой элемент
Код
<span class="user-comment-item__date" data-control="Common.Time" datetime="2018-09-10T07:38:27+0000" data-format="bunin" data-timestamp="1536565107">
Выбираю аттрибут
Код
s = ДатаВремя(0).getAttribute("dateTime")
s=null

Посмотрел значение параметра outerHTML

Код
outerHTML : "<SPAN class=user-comment-item__date dateTime=2018-09-10T07:38:27+0000 data-control="Common.Time" data-timestamp="1536565107" data-format="bunin"></SPAN>" 
Как то можно извлечь этот аттрибут?
Извлечение атрибутов из значения тэга HTML, Как получить дополнительные занчения атрибутов
 
Задача исключительно общая, по извлечению значения дополнительных атрибутов тэгов в HTML.
На HTML странице есть конструкция вида
Код
<div class="user-comment-item" data-commentid="1066835020"> 
Объект div получаем с помощью строки
Код
Set oHtml = New HTMLDocument
Set oElements = oHtml.getElementsByClassName("user-comment-item")

А вот как получить значение аттрибута data-commentid?
Страницы: 1
Наверх