data-raw/update-public/wfl_unlock.R

## code to prepare `wfl_unlock` dataset goes here

# remove sheet protection in Excel
# Sample file: https://www.dropbox.com/s/4ul0kowrscyr8cz/excel_protected.xlsx?dl=0

unlock_xlsx <- function(tar_dir=dir_sel,tar_xls=file_xls){
  # you should firstly "save as" locked .xls to .xlsx format manually.
  library(stringr)
  library(zip)

  # file with protected sheets
  file_locked <- str_replace(basename(tar_xls), ".xls", ".xlsx")
  file_locked_path <- glue::glue("{tar_dir}/{file_locked}")

  # file name and path after removing protection
  file_unlocked <- str_replace(basename(file_locked), ".xlsx$", "-unlocked.xlsx")
  #file_unlocked_path <- glue::glue("{dir_sel}/{file_unlocked}")
  file_unlocked_path <- file.path(getwd(),tar_dir,file_unlocked)

  # create temporary directory in project folder
  # so we see what is going on
  temp_dir <- "data-raw/_tmp"

  # remove and recreate _tmp folder in case it already exists
  unlink(temp_dir, recursive = T)
  dir.create(temp_dir)

  # unzip Excel file into temp folder
  unzip(file_locked_path, exdir = temp_dir)

  # get full path to XML files for all worksheets
  worksheet_paths <- list.files(
    paste0(temp_dir, "/xl/worksheets"),
    full.name = TRUE,
    pattern = ".xml")

  # remove the XML node which contains the sheet protection
  # We might of course use e.g. xml2 to parse the XML file, but this simple approach will suffice here
  for (ws in worksheet_paths) {
    x <- readLines(ws, encoding = "windows1")
    # the "sheetProtection" node contains the hashed password "<sheetProtection SOME INFO />"
    # we simply remove the whole node
    out <- str_replace(x, "<sheetProtection.*?/>", "")
    writeLines(out, ws)
  }

  # create a new zip, i.e. Excel file, containing the modified XML files
  old_wd <- setwd(temp_dir)
  f <- list.files(recursive = T, full.names = F, all.files = T, no..=T)
  # as the Excel file is a zip file, we can directly replace the .zip extension by .xlsx
  zip::zip(file_unlocked_path, files = f) # utils::zip does not work for some reason
  setwd(old_wd)

  # clean up and remove temporary directory
  unlink(temp_dir, recursive = T)
}




# usethis::use_data(wfl_unlock, overwrite = TRUE)
huhuaping/techme documentation built on June 16, 2024, 3:38 a.m.