从R中的Excel文件中提取超链接

Question

如何在 Excel 中获取具有超链接文本的单元格并提取超链接部分？

Answer 1

我发现了一种超复杂的提取超链接的方法：

library(XML)

# rename file to .zip
my.zip.file <- sub("xlsx", "zip", my.excel.file)
file.copy(from = my.excel.file, to = my.zip.file)

# unzip the file
unzip(my.zip.file)

# unzipping produces a bunch of files which we can read using the XML package
# assume sheet1 has our data
xml <- xmlParse("xl/worksheets/sheet1.xml")

# finally grab the hyperlinks
hyperlinks <- xpathApply(xml, "//x:hyperlink/@display", namespaces="x")

源自this blogpost。

Answer 2

受上述@rrs 帖子的启发，我整理了一个函数来提取工作簿中的所有超链接，并带有参考（表格！A1 格式），您可以使用它在任何单元格中查找超链接。

**一些注释解释了下面的sn-p：**

-- 解压 excel 文件后，超链接存储在两个文件中，(a) xl/worksheets/sheet1.xml 和 xl/worksheets/_rels/sheet1.xml.res。虽然 xml 具有到 rId（关系 id？）表的单元格位置，但 xml.res 具有实际的 rId 和超链接表

-- 嵌入函数 read_relationships 解析 XML 并加入它们

-- temp_base_dir 用于承载文件操作

-- map_df 将所有选项卡中的超链接堆叠在一起

-- 输出数据框有 5 列。即 id（关系 id）、target（超链接）、ref（工作表中的单元格引用！A1 格式）、tab_idx（工作表索引）、tab（工作表名称）

片段：

library(tidyverse)
library(XML)
extract_hyperlinks_from_excel <- function(aExcelFile, aRefOutputFile = NULL){
  sheets <- readxl::excel_sheets(aExcelFile)
  
  read_relationships <- function(aSheetIndex){
    filename <- file.path(tmp_base_dir, 'xl', 'worksheets', '_rels', paste0('sheet', aSheetIndex, '.xml.rels'))    
    rel <- xmlParse(filename)
    rel <- xmlToList(rel)
    rel <- purrr::map_dfr(rel, as.list)
    rel <- rel[, c('Id', 'Target')]
    names(rel) <- c('id', 'target')
    if(nrow(rel) == 0){
      return(NULL)
    }
    
    filename <- file.path(tmp_base_dir, 'xl', 'worksheets', paste0('sheet', aSheetIndex, '.xml'))    
    pos <- xmlParse(filename)
    pos <- xmlToList(pos)
    if(is.null(pos$hyperlinks)){
      return(NULL)
    }
    
    pos <- purrr::map_dfr(pos$hyperlinks, as.list)
    pos <- pos[, c('ref', 'id')]
    
    ret <- inner_join(rel, pos, by = 'id')
    ret$tab_idx <- aSheetIndex
    
    return(ret)
  }
  
  EXCEL_TEMP_NAME <- 'unzipped_excel'
  
  tmp_base_dir <- file.path(tempdir(),
                            paste0('tmpexcl', 
                                   as.character(round(runif(1, 1000000000000, 9999999999999)))))
  dir.create(tmp_base_dir)
  on.exit(unlink(tmp_base_dir))
  
  zipfile <- file.path(tmp_base_dir, paste0(EXCEL_TEMP_NAME, '.zip'))
  file.copy(from = aExcelFile, to = zipfile)
  unzip(zipfile, exdir = tmp_base_dir)
  
  ret <- map_df(seq_along(sheets), read_relationships)
  
  ret %>% 
    mutate(tab = sheets[tab_idx]) %>% 
    mutate(ref = paste0("'", tab, "'!", ref)) %>% 
    select(id,tab_idx, tab, ref, target)  ->
    ret

  if(!is.null(aRefOutputFile)){
    write_csv(ret, aRefOutputFile)
  }
  
  return(ret)
}