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
精彩评论