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

Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 15 След.
Парсинг данных с сайта со скриптами.
 
Добрый день,

По данной ссылке пытаюсь получить  стоимость товара ($99.97).
Т.к сначала необходимо дождаться срабатывания всех скриптов, то делаю это через IE.
Однако, несмотря на
Код
While ie.ReadyState <> 4
    DoEvents
Wend
Страница все равно не успевает прогрузиться (как мне кажется) и получается, что невозможно вытянуть цену.
Весь код предельно прост:
Код
Sub ImportData()
    Set ie = CreateObject("InternetExplorer.Application")
    ie.Visible = True
    sURL = "https://www.walmart.ca/en/ip/coffee-table-rustic-oak/6000199108427"
    ie.Navigate sURL
    
    While ie.ReadyState <> 4
        DoEvents
    Wend
    
    Strh = ie.Document.body.innerText
    
    Set objRegExp = CreateObject("VBScript.RegExp")
    objRegExp.Global = True
    objRegExp.Pattern = "(<span class=""css-2vqe5n esdkp3p0"".*?>)(.*?)(</span>)"
    
    If objRegExp.Execute(Strh).Count <> 0 Then
        MsgBox objRegExp.Execute(Strh).Item(0).submatches.Item(1)
    End If
End Sub  
Скрытый текст


Есть идеи, каким образом можно вытянуть цену?
Сборка данных из CSV файлов. Нехватка оперативки.
 
PooHkrd,
абсолютно не принципиально, но хотелось бы понять всё-таки.
Сборка данных из CSV файлов. Нехватка оперативки.
 
PooHkrd,
xlsm, пардон, поправил.
Сборка данных из CSV файлов. Нехватка оперативки.
 
Добрый день,
Есть код, который из собирает в текущий .xlsm файл данные из .csv файлов (все файлы лежат в одной папке).
По сути берет первую строку из .csv файла и копирует её в конец .xlsm.

Однако когда .csv файлов >200 тыс., то чувствуется, что оперативка начинает утекать...Не пойму на каком моменте идет утечка, сами ж файлы закрываю вроде, переменные обнуляю.
Может кто ткнуть носом в место, где собака зарыта?
Код
Option Explicit
 
Sub xlsm_csv()
    Dim a_path As String
    Dim csvF As String
    Dim shb As Worksheet
    Dim sh As Worksheet
    Dim WB As Workbook
    
    Dim lcol_from As Long
    Dim lrow_insert As Long
    
    Set shb = ActiveSheet
    a_path = ActiveWorkbook.Path & "\"
    
    csvF = Dir(a_path & "*.csv", vbNormal)
    
    Application.ScreenUpdating = False
    Do Until csvF = ""

        Set WB = Nothing
        Set sh = Nothing

        Set WB = Workbooks.Open(Filename:=a_path & csvF, ReadOnly:=True, Local:=True)
        Set sh = WB.Worksheets(1)
        lcol_from = sh.Cells(1, sh.Columns.Count).End(xlToLeft).Column
        lrow_insert = shb.Cells(shb.Rows.Count, 1).End(xlUp).Row + 1
        shb.Range(shb.Cells(lrow_insert, 1), shb.Cells(lrow_insert, lcol_from)) = _
            sh.Range(sh.Cells(1, 1), sh.Cells(1, lcol_from)).Value
        WB.Close False
        csvF = Dir()
    Loop
    Application.ScreenUpdating = True
End Sub
Изменено: heso - 3 Фев 2020 10:53:04 (.xls -> .xlsm)
Получение данных с FTP c помощью VBA
 
БМВ, да.
Дмитрий(The_Prist) Щербаков, в браузере, руками нажимаю скачать - качается. через VBA не хочет.
Получение данных с FTP c помощью VBA
 
Дмитрий(The_Prist) Щербаков,

FTP:
Код
HostName = "91.122.30.115"
Руками все спокойно выкачивается. Через shell тоже.
Хочу просто из корня скачать robots.txt.
Изменено: heso - 24 Янв 2020 14:07:05
Получение данных с FTP c помощью VBA
 
Дмитрий(The_Prist) Щербаков,
Код
FtpGetFileA(hConn, strRemoteFile, strLocalFile, 1, 0, FTP_TRANSFER_TYPE_UNKNOWN Or INTERNET_FLAG_RELOAD, 0)
возвращает 0.

Уже перепробовал и
remoteMatchFile = "/robots.txt"
remoteMatchFile = "//robots.txt"
remoteMatchFile = ":/robots.txt"
Получение данных с FTP c помощью VBA
 
Добрый день.
Условие: необходимо забрать с ftp файл, расположенный в корне.
Код
Private Const FTP_TRANSFER_TYPE_UNKNOWN     As Long = 0
Private Const INTERNET_FLAG_RELOAD          As Long = &H80000000
 
Private Declare Function InternetOpenA Lib "wininet.dll" ( _
    ByVal sAgent As String, _
    ByVal lAccessType As Long, _
    ByVal sProxyName As String, _
    ByVal sProxyBypass As String, _
    ByVal lFlags As Long) As Long
 
Private Declare Function InternetConnectA Lib "wininet.dll" ( _
    ByVal hInternetSession As Long, _
    ByVal sServerName As String, _
    ByVal nServerPort As Long, _
    ByVal sUsername As String, _
    ByVal sPassword As String, _
    ByVal lService As Long, _
    ByVal lFlags As Long, _
    ByVal lContext As Long) As Long
 
Private Declare Function FtpGetFileA Lib "wininet" ( _
    ByVal hConnect As Long, _
    ByVal lpszRemoteFile As String, _
    ByVal lpszNewFile As String, _
    ByVal fFailIfExists As Long, _
    ByVal dwFlagsAndAttributes As Long, _
    ByVal dwFlags As Long, _
    ByVal dwContext As Long) As Long
    
Private Declare Function InternetCloseHandle Lib "wininet" ( _
    ByVal hInet As Long) As Long
 
Sub FtpDownload(ByVal strRemoteFile As String, ByVal strLocalFile As String, ByVal strHost As String, ByVal lngPort As Long, ByVal strUser As String, ByVal strPass As String)
    Dim hOpen   As Long
    Dim hConn   As Long
 
    hOpen = InternetOpenA("FTPGET", 1, vbNullString, vbNullString, 1)
    hConn = InternetConnectA(hOpen, strHost, lngPort, strUser, strPass, 1, 0, 2)
 
    If FtpGetFileA(hConn, strRemoteFile, strLocalFile, 1, 0, FTP_TRANSFER_TYPE_UNKNOWN Or INTERNET_FLAG_RELOAD, 0) Then
        Debug.Print "Success"
    Else
        Debug.Print "Fail"
    End If
 
    'Close connections
    InternetCloseHandle hConn
    InternetCloseHandle hOpen
End Sub

Sub TestDownload()
    localFolder = "C:\rr.txt"
    HostName = "91.122.30.115"
    port = 21
    Username = ""
    Password = ""
    remoteMatchFile = "robots.txt"
   FtpDownload remoteMatchFile, localFolder, HostName, 21, Username, Password
End Sub
С сервером коннектится, однако файл не хочет забирать.

Безусловно, существует 100500 вопросов по данной теме(только на этом форуме 4 страницы в поисковой выдаче),
Но ступор какой то.

Что я не так делаю?
VBE Tools v2.0. Поиск установочного файла программы.
 
БМВ, Alemox,
Спасибо.
VBE Tools v2.0. Поиск установочного файла программы.
 
Добрый день,
Ни у кого не завалялся в закромах установочник VBE Tools v2.0?
Переустановил систему, а про эту полезную вещь забыл. С сайта возвращает 500 ошибку.
Условное форматирование даты в интервале
 
Breathe of fate,
Что именно не отработало?
Скрытый текст
Изменено: heso - 25 Окт 2019 05:45:05
Условное форматирование даты в интервале
 
Код
=AND((TODAY()-F6)>8;(TODAY()-F6)<15)
Изменено: heso - 24 Окт 2019 14:42:36
Автоматическое дополнение ссылки
 
LANdux,
Код
For Each ccell In Selection
    ActiveSheet.Hyperlinks.Add Anchor:=ccell, Address:=" https://www.google.com/search?q=" & ccell.Value
Next
Обновление данных в таблице
 
вы написали этот вопрос в платной теме - уверены?
если что - написал на почту.
Изменено: heso - 19 Авг 2019 14:36:01
Макрос по удалению значений из ячеек (платно), Нужен макрос
 
Не очень понял, но если товарищи Александр и БМВ не взялись за задание - готов попробовать.
В работе.

Выполнено, оплачено.
Изменено: heso - 15 Июл 2019 07:42:43
Округление значения до определенного числа, с условием
 
ошибка то скорее всего потому, что у автора стиль ссылок в эксэле не R1C1, а А1
Сделать таблицу выходов муз.треков
 
Выполнено, оплачено
Сделать таблицу выходов муз.треков
 
Написал в ЛС
В работе.
Изменено: heso - 22 Мар 2019 20:49:06
[ Закрыто] Нужна помощь по VBA и .dat, Прошу помощи в коде
 
Добрый день,
Вы бы скинули не скриншоты, а примеры самих файлов+ваши наработки модуля кнопки для формы.
Определение границ интервалов, в которых значение ниже заданного критерия
 
подкорректировал предыдущий ответ
Быстрый способ копирования содержимого ячейки из одной таблицы в другую
 
  1. Я бы заранее создал отдельный столбец с идентификаторами для каждой таблицы
  2. Прошелся бы новому столбцу идентификаторов первой таблице for'ом, а по второй искал бы в столбце идентификаторов Find'ом
Вы пример бы приложили файла(-ов): так бы вам быстрее помогли.
Определение границ интервалов, в которых значение ниже заданного критерия
 
Код
For i = 0 To UBound(AllText)
    If AllText(i) <> "" Then
        buff = Split(AllText(i), " ")
        For j = 0 To UBound(buff)
            Values(i + 1, j + 1) = buff(j)
        Next j
    End If
Next i
InsideInterval = False
For i = 1 To UBound(Values, 1)
    With Worksheets("Sheet1")
       'Debug.Print (Values(i, 1) & " " & Values(i, 2) & " " & Values(i, 3))
        If InsideInterval = False And Values(i, 2) < Values(i, 5) Then
            InsideInterval = True
            lLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
            Top = Values(i, 1)
            .Cells(lLastRow + 1, 1) = Top
        End If
        If InsideInterval = True And Values(i, 2) > Values(i, 5) Then
            InsideInterval = False
            lLastRow = .Cells(Rows.Count, 2).End(xlUp).Row
            Bottom = Values(i - 1, 1)
            .Cells(lLastRow + 1, 2) = Bottom
        End If
        If InsideInterval = True And i = UBound(Values, 1) Then
            InsideInterval = False
            lLastRow = .Cells(Rows.Count, 2).End(xlUp).Row
            Bottom = Values(i, 1)
            .Cells(lLastRow + 1, 2) = Bottom
        End If
    End With
Next
      
Изменено: heso - 11 Мар 2019 13:00:52
Макрос для переадресации писем в Outlook, Нужен макрос, который будет просматривать письма в выбранной папке Outlook по условию в теме письма (скорее всего ФИО) и перенаправлять его адресату. Условия (ФИО и адрес электронной почты) содержаться в таблице Excel
 
Задание уже не актуально/выполнено?
Если в столбце с третьей строки нет записей, то сообщение, иначе цикл
 
Код
lrow = Cells(Rows.Count, 8).End(xlUp).Row
If lrow < 4 Then
    MsgBox "ячейки пустые"
Else
    For i = 1 To 2
        'тело цикла
    Next
End If
Сделать экселевский файл, нужно сделать файл со сложной структурой и макросами
 
день добрый,
какой предполагаемый бюджет?
Подсчет количества по заданным условиям
 
Отписал на почту
В работе
Выполнено, оплачено.
Изменено: heso - 13 Окт 2017 19:51:09
Применение макроса к нескольким листам, Помогите модифицировать
 
Код
Sub Del_rows()
    Dim x As Range
    Application.ScreenUpdating = False
    For Each sh In Sheets
    
        If sh.Name = "один_из_листов" Then
            Set f_column = sh.[G:G]
        Else
            Set f_column = sh.[F:F]
        End If
        
        Set x = Intersect(sh.UsedRange, f_column)
        f_column.AutoFilter Field:=1, Criteria1:="0"
        x.Offset(1).Resize(x.Rows.Count).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        f_column.AutoFilter
    Next
    Application.ScreenUpdating = True
End Sub
Изменено: heso - 2 Окт 2017 08:38:56
Логи по всем действиям, производимым в файле
 
ScorpionS, Вы не это ищете?
Расчет данных
 
отписал на почту.
В работе
Изменено: heso - 5 Июл 2017 15:28:48
Группировка фраз, Функционал группировки фраз по определенным правилам
 
отписал на почту.
В работе.
Выполнено, оплачено.
Изменено: heso - 27 Июн 2017 15:00:10
Страницы: 1 2 3 4 5 6 7 8 9 10 11 ... 15 След.
Наверх