Excel下载数据并显示在工作表中

Question

我正在寻找一种从服务器下载数据，然后将其显示在工作表中的方法。到目前为止，我已经创建了两个工作表Home&Sites

在主页工作表上，我有两个单元格D19&D20，用于用户的用户名和密码。我想做的是添加一个下载按钮，这样当他们点击它时，用户名和密码就会提交到服务器，然后下载详细信息。

服务器URL的格式如下：http://example.com?usr=USERNAME&pwd=密码

下载的结果是一个具有多个逗号分隔值的数据字符串。每个新条目都在一条新行上：例如：

"NW21-A76","Upstate","798952124"
"NP54-P87","Local","798927272"
"SK06-001","N/A","543666788"

我需要获取这些数据并用逗号分隔，将值写入"站点"工作表。B10中的第一个值、第二个C10和D10中的第三个值。B11、C11、D11等中的新数据行

有人能给我一些关于如何做到这一点的想法或建议吗？

感谢

更新。我已经完成了这项工作，但对行和单元格的写入非常缓慢。有更好的方法吗？

Private Sub To_Excel()
Dim oXMLHTTP As Object
Dim sResponse  As String
Dim sURL As String
destRow = 10

user = ThisWorkbook.Sheets("Home").Range("A1")
pwd = ThisWorkbook.Sheets("Home").Range("A2")


sURL = "http://example.com?user=" & user & "&upassword=" & pwd
'Extract data from website to Excel using VBA
Set oXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")
oXMLHTTP.Open "GET", sURL, False
oXMLHTTP.send
sResponse = oXMLHTTP.responseText
sResponse = Replace(sResponse, vbCrLf, vbCr)
sResponse = Replace(sResponse, vbLf, vbCr)
sResponse = Replace(sResponse, """", "")
rowData = Split(sResponse, vbCr)

If (InStr(sResponse, "ERROR")) Then
MsgBox "Error: " & vbCrLf & vbCrLf & sResponse
End
End If

For Counter = 0 To UBound(rowData)
Row = rowData(Counter)

Column = Split(Row, ",")
valA = Column(0)
valB = Column(1)
valC = Column(2)

ThisWorkbook.Sheets("Sites").Cells(destRow, 2) = valA
ThisWorkbook.Sheets("Sites").Cells(destRow, 3) = valB
ThisWorkbook.Sheets("Sites").Cells(destRow, 4) = valB
destRow = destRow + 1

Next
End Sub

感谢

Answer 1

将文本文件写入临时文件并作为工作簿打开。将数据提取到一个数组中，复制到另一个反转列的数组中，然后写入工作表。关闭并删除临时文件。

Option Explicit
Sub To_Excel()
Const URL = "http://example.com"
Const STARTROW = 10

Dim oXMLHTTP As Object, sResponse  As String, sUrl As String
Dim user As String, pwd As String

'Extract data from website to Excel using VBA
With ThisWorkbook.Sheets("Home")
user = .Range("A1")
pwd = .Range("A2")
End With
sUrl = URL & "?user=" & user & "&upassword=" & pwd
Set oXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")
oXMLHTTP.Open "GET", sUrl, False
oXMLHTTP.send
sResponse = oXMLHTTP.responseText

'Debug.Print sResponse
If (InStr(sResponse, "ERROR")) Then
MsgBox "Error: " & vbCrLf & vbCrLf & sResponse
End
End If

' save to temp file
Dim FSO As Object, ts As Object, tmpFile As String
Set FSO = CreateObject("Scripting.FileSystemObject")
tmpFile = Environ("Temp") & "~tmp.csv"
'Debug.Print tmpFile

Set ts = FSO.CreateTextFile(tmpFile)
ts.write sResponse
ts.Close
'Shell "notepad.exe " & tmpFile

Dim wbCsv As Workbook
Dim arIn, arOut
Dim r As Long, c As Long, lastRow As Long, lastCol

' open temp file as workbook
Set wbCsv = Workbooks.Open(tmpFile, ReadOnly:=True)
Application.ScreenUpdating = False
With wbCsv.Sheets(1)
arIn = .UsedRange.Value
lastRow = UBound(arIn)
lastCol = UBound(arIn, 2)

' reverse columns
ReDim arOut(1 To lastRow, 1 To lastCol)
For r = 1 To lastRow
For c = 1 To lastCol
arOut(r, c) = arIn(r, lastCol - c + 1)
Next
Next
wbCsv.Close SaveChanges:=False
End With

' remove temp file
Kill tmpFile

' write data to sheet
With ThisWorkbook.Sheets("Sites")
.Range("B" & STARTROW).Resize(lastRow, lastCol).Value = arOut
.Columns("B:D").AutoFit
End With
Application.ScreenUpdating = True

MsgBox lastRow & " rows downloded", vbInformation
End Sub