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

Question

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

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

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

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

"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

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

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

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

Excel Download data and display in worksheet?

excel

vba

download