Excel VBA QueryTable unsupported in "Shared Workbook" mode

I use a QueryTable in excel vba to retrieve data from a website. This works fine when the workbook is not in 'Shared Workbook' mode. Once I turn on 'Shared Workbook' and run the vba code excel returns an error message - 'Microsoft Excel -- This command is not available in a shared workbook'. The code that vba stops on is

Dim query As QueryTable

Set query = Application.ActiveSheet.QueryTables.Add(Connection:=url, Destination:=Range("A1"))

...

query.Name = "get data" <-- HERE

Is there another way开发者_运维百科 of retrieving the data?

You can refresh a query table in a shared workbook. So if it fits your situation, you can set up the query in your template when it's not shared, then share it, then do the refresh via VBA. That's the easiest way.

If you can't set it up beforehand, you can use MSXML to get the web data and paste it into your sheet with VBA. You'll need to set a reference (VBE - Tools - References) to Microsoft XML, v5.0 and to Microsoft Forms 2.0 Object Library (for the clipboard). Then you can run code like this to get a table out of a web page.

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

There's no error checking in there. You may want to add some code to make sure you find the web page and that it contains the data you want.