开发者

VBA Scripting: QueryTable in a loop doesn't leave retrieved text in cell

开发者 https://www.devze.com 2023-03-26 04:48 出处:网络
VBA noob here (just started using it yesterday) on Excel 2007, and I\'m trying to map user names to full names using QueryTables and a loop.

VBA noob here (just started using it yesterday) on Excel 2007, and I'm trying to map user names to full names using QueryTables and a loop.

I have most of it done, it's just that as it runs, it fills in the cell correctly, but when it gets to the next cell, it clears the contents of the cell above it. Basically, I see the names "traveling" down the list, and at the end I just have one name at the very bottom.

My table starts like this:

| user name | full name  |
| psmith    |            |
| duane     |            |
| susanl    |            |

My table is supposed to look like this after I run the macro:

| user name | full name     |
| psmith    | Peter Smith   |
| duane     | Duane Roberts |
| susanl    | Susan Li      |

But instead I get this as it runs (pretend it's like an animation):

| user name | full name     |
| psmith    | Peter Smith   |
| duane     |               |
| susanl    |               |

| user name | full name     |
| psmith    |               |
| duane     | Duane Roberts |
| susanl    |               |

| user name | full name     |
| psmith    |               |
| duane     |               |
| susanl    | Susan Li      |

My code looks like:

Dim rngUserName As Range
Dim userName As String

Set rngUserName = ActiveSheet.Range("D2")

Do Until IsEmpty(rngUserName.Offset(0, -1))
    userName = rn开发者_如何学JAVAgUserName.Offset(0, -1).Value
    With Worksheets(1).QueryTables.Add(Connection:= _
        "URL;http://mysite.com/scripts/cgi-bin/map_name.cgi?" & userName, _
        Destination:=rngUserName)
        .Name = "map_name.cgi?" & userName & "_1"
        .FieldNames = False
        .RowNumbers = False
        .FillAdjacentFormulas = True
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlAllTables
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = False
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery = True
    End With

    Set rngUserName = rngUserName.Offset(1, 0)
Loop

Why is the retrieved text not sticking?? It's driving me nuts and Google isn't helping...

Thanks!!


Here's an alternative approach without the querytables:

Sub Tester()
  Const URL as string = "http://mysite.com/scripts/cgi-bin/map_name.cgi?"
  Dim userName as string 
  Dim rngUserName as range   

  Set rngUserName = ActiveSheet.Range("B2") 

  Do Until IsEmpty(rngUserName.Offset(0, -1))          
    userName = rngUserName.Offset(0, -1).Value         
    rngUserName.Value = WebResponse(URL & userName)
    Set rngUserName = rngUserName.Offset(1, 0)      
  Loop 
End sub


Private Function WebResponse(URL As String) As String
    Dim XmlHttpRequest As Object
    Set XmlHttpRequest = CreateObject("MSXML2.XMLHTTP")
    XmlHttpRequest.Open "GET", URL, False
    XmlHttpRequest.send
    WebResponse = XmlHttpRequest.responseText
End Function


Your rRow variable isn't matching up with the Activecell. Better also to avoid selecting if you can.

Dim userName as string
Dim rngUserName as range


Set rngUserName = ActiveSheet.Range("B2")
Do Until IsEmpty(rngUserName.Offset(0, -1))     

   userName = rngUserName.Offset(0, -1).Value     
   With Worksheets(1).QueryTables.Add(Connection:= _         
      "URL;http://mysite.com/scripts/cgi-bin/map_name.cgi?" & userName, _
       Destination:=rngUserName)         
    .Name = "map_name.cgi?" & userName & "_1"         
    '....         
    .Refresh BackgroundQuery:=False     
   End With     

   Set rngUserName = rngUserName.Offset(1, 0)    

Loop
0

精彩评论

暂无评论...
验证码 换一张
取 消