使用VBA宏从需登录网站向Excel导入数据

一、完善VBA代码实现自动登录 #

你的现有代码仅能打开网页，需补充登录操作逻辑——核心是定位网页的用户名输入框、密码输入框和登录按钮，模拟输入与点击操作。

示例代码（需根据实际网页元素调整） #

Sub AutoLoginAndScrape()
    Dim ie As Object
    Dim usernameInput As Object
    Dim passwordInput As Object
    Dim loginBtn As Object
    
    ' 创建IE对象
    Set ie = CreateObject("INTERNETEXPLORER.APPLICATION")
    ie.navigate "http://emonitoring.pu.go.id"
    ie.Visible = True ' 调试时设为True，正式运行可改为False
    
    ' 等待页面完全加载
    Do While ie.Busy Or ie.ReadyState <> 4
        DoEvents
    Loop
    
    ' 定位用户名输入框（替换为网页实际元素ID/名称）
    Set usernameInput = ie.document.getElementById("username") ' 假设ID为username
    If Not usernameInput Is Nothing Then
        usernameInput.Value = "你的用户名"
    End If
    
    ' 定位密码输入框（替换为网页实际元素ID/名称）
    Set passwordInput = ie.document.getElementById("password") ' 假设ID为password
    If Not passwordInput Is Nothing Then
        passwordInput.Value = "你的密码"
    End If
    
    ' 定位登录按钮并点击（替换为网页实际元素选择器）
    Set loginBtn = ie.document.getElementById("loginBtn") ' 假设ID为loginBtn
    If Not loginBtn Is Nothing Then
        loginBtn.Click
    End If
    
    ' 等待登录后页面加载完成
    Do While ie.Busy Or ie.ReadyState <> 4
        DoEvents
    Loop
    
    ' 调用数据抓取函数
    Call ScrapeData(ie)
    
    ' 关闭IE（可选）
    ie.Quit
    Set ie = Nothing
End Sub

关键说明： #

打开目标网页按F12启动开发者工具，找到用户名、密码输入框和登录按钮的ID/名称/类名，替换代码中对应值。若元素无ID，可尝试用getElementsByTagName或getElementsByClassName定位。

二、登录后抓取数据至Excel #

登录完成后，定位目标数据所在区域（通常是<table>标签），遍历行和列将数据写入Excel工作表。

数据抓取示例函数 #

Sub ScrapeData(ie As Object)
    Dim targetTable As Object
    Dim row As Object
    Dim cell As Object
    Dim excelRow As Integer
    Dim excelCol As Integer
    
    ' 定位目标表格（替换为网页实际表格ID/索引）
    Set targetTable = ie.document.getElementById("dataTable") ' 假设表格ID为dataTable
    If targetTable Is Nothing Then
        MsgBox "未找到目标数据表格"
        Exit Sub
    End If
    
    ' 清空当前工作表数据（可选）
    Sheets("Sheet1").Range("A1:Z1000").ClearContents
    
    ' 遍历表格行和列，写入Excel
    excelRow = 1
    For Each row In targetTable.Rows
        excelCol = 1
        For Each cell In row.Cells
            Sheets("Sheet1").Cells(excelRow, excelCol).Value = cell.innerText
            excelCol = excelCol + 1
        Next cell
        excelRow = excelRow + 1
    Next row
    
    MsgBox "数据抓取完成"
End Sub

关键说明： #

若页面存在多个表格，可通过getElementsByTagName("table")(0)（0代表第一个表格）定位目标数据区域。

三、实现数据频繁更新 #

通过Excel的Application.OnTime方法设置定时任务，重复执行登录与抓取代码。

定时更新示例代码 #

Sub StartAutoUpdate()
    ' 设置每30分钟执行一次（可调整时间间隔）
    Application.OnTime Now + TimeValue("00:30:00"), "AutoLoginAndScrape"
    MsgBox "已开启自动更新，每30分钟执行一次"
End Sub

Sub StopAutoUpdate()
    ' 取消定时任务（需与启动时的时间和过程名一致）
    On Error Resume Next
    Application.OnTime Now + TimeValue("00:30:00"), "AutoLoginAndScrape", , False
    On Error GoTo 0
    MsgBox "已停止自动更新"
End Sub

关键说明： #

运行StartAutoUpdate开启定时更新，运行StopAutoUpdate停止。时间间隔可按需修改，比如"00:10:00"代表每10分钟执行一次。

注意事项 #

1. IE兼容性：部分现代网站不再支持IE，若代码运行异常，可考虑改用基于Microsoft Edge WebDriver的VBA方案（需下载Edge驱动并配置）。
2. 网页元素变化：若网站更新页面结构，需重新定位元素ID/选择器。
3. 账号安全：代码中直接写入用户名和密码存在风险，可改为通过输入框或指定单元格读取账号信息。

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