VBA脚本：循环中的QueryTable不会将检索到的文本留在单元格中
VBA noob在这里（刚开始使用它昨天）在Excel 2007中，我试图映射用户名到全名使用QueryTables和循环。
我已经完成了大部分工作，只是在运行的时候，它正确地填充了单元格，但是当它到达下一个单元格时，将清除它上面的单元格的内容。 基本上，我看到名单上的“旅行”，最后我只有一个名字。
我的桌子开始是这样的：
| user name | full name | | psmith | | | duane | | | susanl | | 运行macros后，我的表应该看起来像这样：
| user name | full name | | psmith | Peter Smith | | duane | Duane Roberts | | susanl | Susan Li |
但相反，当它运行时（假设它像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 |
我的代码如下所示：
Dim rngUserName As Range Dim userName As String Set rngUserName = ActiveSheet.Range("D2") 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" .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
为什么检索到的文字不粘？ 这使我疯狂，Google不帮忙…
谢谢！！
这是一个没有查询表的替代方法：
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
您的rRowvariables与Activecell不匹配。 如果可以，也要避免select。
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