Excel это не сложно
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
28.03.2024, 18:45:58

Войти
На форуме добавлена возможность подписки на RSS-ленты любого раздела форума. Подписаться можно, нажав на иконку RSS , расположенную левее наименования раздела.
33 233 Сообщений в 5 454 Тем от 6 750 Пользователей
Последний пользователь: Alex1210
*
Перейти на сайт Хитрости Надстройка MulTEx Обучающие тренинги Наша группа ВКонтакте
Правила форума Начало Помощь Поиск Календарь Войти Регистрация Выйти
+  Excel это не сложно
|-+  Основные форумы
| |-+  Вопросы по Excel и VBA
| | |-+  Получение интернет-ссылки от пользователя через форму
Страниц: [1]   Вниз
Печать
Автор Тема: Получение интернет-ссылки от пользователя через форму  (Прочитано 2710 раз)
0 Пользователей и 1 Гость смотрят эту тему.
firestarter
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 26


Просмотр профиля E-mail
« : 26.11.2020, 18:27:39 »

Здравствуйте!

Есть вопрос на который никак не могу найти полноценный ответ.

У меня есть "веб-запрос" который выдает на лист данные из вшитой в него ссылки:
Код: (vb)
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;https://www.примерсайта.ru/contents.asp?titleid=123456", Destination:=Range("A1"))
        .Name = "Res"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = """restab"""
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With

(вставил именно в таком виде, потому что в случае использования "режима кода" - данные дублируются)

Необходимо сделать так, чтобы ссылку для этого запроса давал сам пользователь (из формы).
И после успешного получения ссылки - отрабатывается запрос.
И, казалось бы, самый простой способ - запросить ее из формы типа MSGBOX в параметр, например вот так:
Код: (vb)
    On Error Resume Next
    Set vRetVal = Application.InputBox("Введите ссылку:", "Получение ссылки")
    If vRetVal Is Nothing Then
        MsgBox "Отмена", vbCritical, "Нет данных"
    End If

А потом вставить этот параметр в запрос:
Код: (vb)
        "URL;vRetVal", Destination:=Range( _
        "A1"))

Однако, в таком виде решение не работает; вероятно, в MSGBOX не заложен необходимый функционал.
Пока найти подходящее решение не получается.

Буду рад любой помощи.
Заранее благодарю!
« Последнее редактирование: 26.11.2020, 19:10:24 от Дмитрий Щербаков(The_Prist) » Записан
vikttur
Глобальный модератор
Ветеран
*****

Репутация: +124/-0
Офлайн Офлайн

Сообщений: 1 816



Просмотр профиля
« Ответ #1 : 26.11.2020, 18:38:10 »

Это полезное решение?
Записан
firestarter
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 26


Просмотр профиля E-mail
« Ответ #2 : 26.11.2020, 18:57:58 »

По отдельности - да: формочка - появляется сама по себе, запрос - отрабатывает сам по себе.
А вместе - нет, потому и спрашиваю любого дельного совета.
Записан
Дмитрий Щербаков(The_Prist)
Администратор
Ветеран
*****

Репутация: +485/-0
Офлайн Офлайн

Сообщений: 5 828



Просмотр профиля WWW
« Ответ #3 : 26.11.2020, 19:09:35 »

потому и спрашиваю любого дельного совета
В этой ветке выкладывают ГОТОВЫЕ решения. А не куски кода и вопросы "а как мне теперь допилить это или то, чтобы проблему свою решить".
вероятно, в MSGBOX не заложен необходимый функционал
нет. Просто надо хотя бы начать учить азы VBA, чтобы синтаксис знать:
Код: (vb)
With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;" & vRetVal, Destination:=Range("A1"))

рано Вам еще до этого раздела  Улыбка

По отдельности - да: формочка - появляется сама по себе, запрос - отрабатывает сам по себе.
А вместе - нет, потому и спрашиваю любого дельного совета.
ну дожили: первая часть это просто кусок от макрорекордера без всяких правок, а про InputBox скопировали часть моего кода из моей же статьи на сайте(Работа с диалогами) и выкладываете как полезное решение у меня же на сайте  Смеющийся
Тема перенесена в основной раздел.
« Последнее редактирование: 26.11.2020, 19:14:31 от Дмитрий Щербаков(The_Prist) » Записан

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Пункты приёма Спасибов:    -41001332272872  -R298726502453
firestarter
Новичок
*

Репутация: +0/-0
Офлайн Офлайн

Сообщений: 26


Просмотр профиля E-mail
« Ответ #4 : 26.11.2020, 19:56:28 »

Извините, возможно я просто ошибся темой; очень хотелось найти решение.

Если кому-то будет интересно, вот рабочий вариант:
Код: (vb)
Sub EX()
        Dim vRetVal
        On Error Resume Next
        vRetVal = InputBox("Введите ссылку:", "Получение ссылки")
        If vRetVal = "" Then Exit Sub

        With ActiveSheet.QueryTables.Add(Connection:= _
            "URL;" & vRetVal, Destination:=Range("A1"))
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlSpecifiedTables
            .WebFormatting = xlWebFormattingNone
            .WebTables = """restab"""
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
End Sub


Спасибо за помощь
Записан
Страниц: [1]   Вверх
Печать
Перейти в:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2006-2011, Simple Machines Valid XHTML 1.0! Valid CSS!
Яндекс.Метрика Рейтинг@Mail.ru