Excel VBA QueryTable не поддерживается в режиме «Общая книга»

Question

Я использую QueryTable в Excel VBA для получения данных с веб-сайта.Это прекрасно работает, когда рабочая книга не находится в режиме «Общая рабочая книга».Как только я включаю «Общая книга» и запускаю код vba, Excel возвращает сообщение об ошибке - «Microsoft Excel - эта команда недоступна в общей книге».Код, на котором останавливается vba:

Dim-запрос As QueryTable

Установить запрос = Application.ActiveSheet.QueryTables.Add (соединение: = URL, назначение: = диапазон («A1»))

...

query.Name = "get data" <- HERE </p>

Есть ли другой способ получения данных?

Answer 1

Вы можете обновить таблицу запросов в общей рабочей книге. Поэтому, если это соответствует вашей ситуации, вы можете настроить запрос в своем шаблоне, когда он не используется совместно, затем поделиться им, а затем выполнить обновление через VBA. Это самый простой способ.

Если вы не можете настроить его заранее, вы можете использовать MSXML, чтобы получить веб-данные и вставить их на свой лист с помощью VBA. Вам нужно будет установить ссылку (VBE - Инструменты - Ссылки) на Microsoft XML v5.0 и библиотеку объектов Microsoft Forms 2.0 (для буфера обмена). Затем вы можете запустить такой код, чтобы вытащить таблицу с веб-страницы.

Sub GetData()

    Dim oHttp As MSXML2.XMLHTTP50
    Dim sHtml As String
    Dim lTableStart As Long, lTableEnd As Long
    Dim doClip As MSForms.DataObject

    Const sTABLESTART As String = "<table id=""table1"">"
    Const sTABLEEND As String = "</table>"

    'create a new request object
    Set oHttp = New MSXML2.XMLHTTP50

    'open the request and send it
    oHttp.Open "GET", "http://finance.yahoo.com/q?s=^GSPC", False
    oHttp.send

    'get the response - a bunch of html
    sHtml = oHttp.responseText

    'define where your data starts and ends
    lTableStart = InStr(1, sHtml, sTABLESTART)
    lTableEnd = InStr(lTableStart, sHtml, sTABLEEND)

    'create a new clipboard object
    Set doClip = New MSForms.DataObject

    'set the text and put it in the clipboard
    doClip.SetText Mid$(sHtml, lTableStart, lTableEnd - lTableStart)
    doClip.PutInClipboard

    'one of those rare instances where you actually have to select a range in VBA
    Sheet4.Range("G10").Select
    'blank out the previous results
    Sheet4.Range("G10").CurrentRegion.ClearContents
    'paste the hmtl as text with no formatting
    Sheet4.PasteSpecial "Text", , , , , , True

End Sub

Там нет проверки ошибок там. Возможно, вы захотите добавить код, чтобы убедиться, что вы нашли веб-страницу и в ней содержатся нужные вам данные.