VBA读取NSE接口在线CSV并写入LT、ST工作表的实现方案

需求说明 #

需读取NSE官网生成的在线CSV文件，将数据分别写入标注为「LT（Long Term，长期）」和「ST（Short Term，短期）」的两个工作表。最初使用Workbooks.Open方法无法成功调用CSV下载接口，该接口来自NSE官网ASM报告页的下载按钮，经排查是请求缺少NSE官网校验所需的会话ID、Cookie等参数，且要求全程无需本地保存CSV文件。

初始错误实现 #

直接调用Workbooks.Open拉取CSV的代码无法通过官网校验，参考如下：

Sub Get_NSE_ASM_Data()
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
    
    Dim NSE_ASM_File As Workbook
    
    Set NSE_ASM_File = Workbooks.Open("https://www.nseindia.com/api/reportASM?csv=true", 0, True, 2)
    
    Dim Row_Counter As Integer
    Dim Serial_Number As Integer
    Dim Worksheet_Name As String
            
    Do While True
        Row_Counter = 1
        
        MsgBox NSE_ASM_File.Worksheets(1).Range("A" & Row_Counter).Value
        
        If IsEmpty(NSE_ASM_File.Worksheets(1).Range("A" & Row_Counter).Value) Then
            Exit Do
        ElseIf NSE_ASM_File.Worksheets(1).Range("A" & Row_Counter).Value = "Long Term" Then
            Worksheet_Name = "LT"
            Serial_Number = 1
        ElseIf NSE_ASM_File.Worksheets(1).Range("A" & Row_Counter).Value = "Short Term" Then
            Worksheet_Name = "ST"
            Serial_Number = 1
        ElseIf IsNumeric(NSE_ASM_File.Worksheets(1).Range("A" & Row_Counter).Value) Then
            Worksheets(Worksheet_Name).Range("A" & Serial_Number).Value = NSE_ASM_File.Worksheets(1).Range("A" & Row_Counter).Value
            Worksheets(Worksheet_Name).Range("B" & Serial_Number).Value = NSE_ASM_File.Worksheets(1).Range("B" & Row_Counter).Value
            Worksheets(Worksheet_Name).Range("C" & Serial_Number).Value = NSE_ASM_File.Worksheets(1).Range("C" & Row_Counter).Value
            Worksheets(Worksheet_Name).Range("D" & Serial_Number).Value = NSE_ASM_File.Worksheets(1).Range("D" & Row_Counter).Value
            
            Row_Counter = Row_Counter + 1
            Serial_Number = Serial_Number + 1
        End If
    Loop
    
    Exit Sub
    
ErrHandler:
    MsgBox "Error : " & Err.Description
End Sub

Private Sub Workbook_Open()
    Get_NSE_ASM_Data
End Sub

最终可运行实现 #

通过浏览器开发者工具抓取请求头、响应头规则，借助WinHttpRequest组件先访问目标页面获取合法Cookie，再携带Cookie请求CSV接口，直接解析响应文本拆分写入对应工作表，无需本地存储文件，代码如下：

Private Sub Workbook_Open()
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
    
    Dim winHttpReq As Object
    Set winHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
    
    winHttpReq.Open "GET", "https://www.nseindia.com/reports/asm", False
    winHttpReq.SetRequestHeader "REFERER", "https://www.nseindia.com/reports/asm"
    winHttpReq.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)"
    
    winHttpReq.Send
    
    strCookie = winHttpReq.GetResponseHeader("Set-Cookie")
    
    
    winHttpReq.Open "GET", "https://www.nseindia.com/api/reportASM?csv=true", False
    winHttpReq.SetRequestHeader "REFERER", "https://www.nseindia.com/reports/asm"
    winHttpReq.SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)"
    winHttpReq.SetRequestHeader "cookie", strCookie
    
    winHttpReq.Send

    Dim arrNSEASMRecords As Variant
    Dim arrNSEASMRecordValues As Variant
    
    arrNSEASMRecords = Split(winHttpReq.ResponseText, vbLf)
    
    Dim intNSEASMRecordsCounter As Integer
    Dim intSerialNumberCounter As Integer
    Dim strWorkSheetName As String
    
    For intNSEASMRecordsCounter = 0 To UBound(arrNSEASMRecords) Step 1
        arrNSEASMRecordValues = Split(arrNSEASMRecords(intNSEASMRecordsCounter), ",")
        
        If arrNSEASMRecordValues(0) = """Long Term""" Then
            strWorkSheetName = "LT"
            Worksheets(strWorkSheetName).UsedRange.ClearContents
            intSerialNumberCounter = 1
        ElseIf arrNSEASMRecordValues(0) = """Short Term""" Then
            strWorkSheetName = "ST"
            Worksheets(strWorkSheetName).UsedRange.ClearContents
            intSerialNumberCounter = 1
        ElseIf IsNumeric(arrNSEASMRecordValues(0)) Then
            Worksheets(strWorkSheetName).Range("A" & intSerialNumberCounter).Value = Replace(arrNSEASMRecordValues(0), """", "")
            Worksheets(strWorkSheetName).Range("B" & intSerialNumberCounter).Value = Replace(arrNSEASMRecordValues(1), """", "")
            Worksheets(strWorkSheetName).Range("C" & intSerialNumberCounter).Value = Replace(arrNSEASMRecordValues(2), """", "")
            Worksheets(strWorkSheetName).Range("D" & intSerialNumberCounter).Value = Replace(arrNSEASMRecordValues(3), """", "")
            Worksheets(strWorkSheetName).Range("E" & intSerialNumberCounter).Value = Replace(arrNSEASMRecordValues(4), """", "")
            
            intSerialNumberCounter = intSerialNumberCounter + 1
        End If
        
    Next intNSEASMRecordsCounter
    
    Exit Sub
    
ErrHandler:
    MsgBox "Error : " & Err.Description
End Sub

内容的提问来源于stack exchange，提问作者Aadee Maanav