如何使用R爬取下拉选择触发显示的HTML隐藏表格并导出

核心思路 #

该站点的表格是选择下拉选项后发起POST请求动态加载的，不需要模拟浏览器点击，直接构造对应参数的POST请求即可拿到返回的表格数据。

依赖包安装 #

首先安装所需工具包：

install.packages(c("httr", "rvest", "dplyr", "openxlsx"))

完整实现代码 #

library(httr)
library(rvest)
library(dplyr)
library(openxlsx)

# 配置基础参数
target_url <- "https://www.adfg.alaska.gov/index.cfm?adfg=commercialbyareapws.harvestbydistrict"
district_list <- c(221, 222, 223, 226, 227, 228)
# 存储所有结果的列表
all_result <- list()

# 循环爬取每个区域的表格
for (d in district_list) {
  # 构造POST请求的表单参数，可从网络请求面板的「表单数据」部分核对补全所有隐藏参数
  post_data <- list(
    adfg = "commercialbyareapws.harvestbydistrict",
    district = as.character(d),
    submit = "Get Report"
  )
  
  # 发起POST请求，模拟正常浏览器请求头
  resp <- POST(
    url = target_url,
    body = post_data,
    encode = "form",
    user_agent("Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/118.0.0.0 Safari/537.36")
  )
  
  # 检查请求是否成功
  if (status_code(resp) == 200) {
    # 解析HTML提取表格，可根据实际表格的class/id调整css选择器
    table_df <- resp %>% 
      read_html() %>% 
      html_element(css = "table") %>% 
      html_table(header = TRUE)
    
    # 增加区域编号列方便区分数据
    table_df <- table_df %>% mutate(district = d)
    all_result[[as.character(d)]] <- table_df
    
    # 加请求间隔避免触发反爬
    Sys.sleep(2)
  } else {
    warning(paste("区域", d, "请求失败，状态码：", status_code(resp)))
  }
}

# 合并所有区域数据为一个data.frame
final_df <- bind_rows(all_result)

# 导出为Excel文件
write.xlsx(final_df, "阿拉斯加渔业区域收获数据.xlsx", rowNames = FALSE)

备选方案（站点有反爬校验时使用） #

如果直接发POST请求拿不到数据，可以用RSelenium模拟浏览器操作，自动点击下拉选项拉取表格：

# 安装依赖
install.packages(c("RSelenium", "rvest"))

library(RSelenium)
library(rvest)
library(dplyr)
library(openxlsx)

# 启动浏览器驱动，需和本地Chrome版本匹配
driver <- rsDriver(browser = "chrome", chromever = "本地安装的Chrome版本号")
remDr <- driver$client
remDr$navigate("https://www.adfg.alaska.gov/index.cfm?adfg=commercialbyareapws.harvestbydistrict")

district_list <- c(221, 222, 223, 226, 227, 228)
all_result <- list()

for (d in district_list) {
  # 定位下拉选框选择对应值
  select_elem <- remDr$findElement(using = "css", "select[name='district']")
  select_elem$sendKeysToElement(list(as.character(d)))
  # 点击提交按钮
  submit_elem <- remDr$findElement(using = "css", "input[type='submit']")
  submit_elem$clickElement()
  # 等待表格加载
  Sys.sleep(3)
  # 解析页面表格
  page_source <- remDr$getPageSource()[[1]]
  table_df <- read_html(page_source) %>% 
    html_element("table") %>% 
    html_table(header = TRUE) %>% 
    mutate(district = d)
  all_result[[as.character(d)]] <- table_df
}

# 关闭驱动
remDr$close()
driver$server$stop()

# 合并导出
final_df <- bind_rows(all_result)
write.xlsx(final_df, "阿拉斯加渔业区域收获数据.xlsx", rowNames = FALSE)

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