## Some wrapper functions for XLConnect wb_to_f <- function(f) { clean.capture.output(f) } showXLSsheets <- function(f, wb=loadWorkbook(f), close.when.done=missing(wb)) { stopifnot(require("XLConnect")) if (missing(wb)) { if (inherits(f, "workbook")) wb <- f else if (!is.character(f)) stop ("\nf must be a character string of a filename, or a workbook object") else if (!file.exists(f)) stop ("\nfile not found: \n ", f) } ret <- getSheets(wb) if (close.when.done) { ## I am not sure how to close a wb connection ## closeWorkbook(wb) rm (wb) } return(ret) } XLStoDT <- function(f, sheets=getSheets(wb), wb=loadWorkbook(f), check.names=FALSE, sheetAsCol=simplify , startCol=1 , startRow=1 , discardEmptySheets=TRUE , discardErrors=TRUE , useCachedValues=TRUE , skipSheetsStartingWithUnderscore=TRUE , nm.prefix="DT." ## assignToEnvir is TRUE if nm.prefix is explicitly set and not equal to its default value , assignToEnvir=!identical(nm.prefix, "DT.") & !is.null(nm.prefix) , simplify=TRUE , overwrite.if.exists=FALSE , warn.if.exists=TRUE , showWarnings=FALSE , verbose=TRUE , envir=globalenv()) { stopifnot(require("XLConnect", quietly=TRUE)) if (missing(wb)) { if (inherits(f, "workbook")) wb <- f else if (!is.character(f)) stop ("f must be a character string of a filename, or a workbook object") else if (!file.exists(f)) stop ("file not found: \n ", f) } force (wb) force (sheets) jgc() sheets <- as.character(sheets) ## Clean up sheets and check non-empty if (skipSheetsStartingWithUnderscore) sheets <- sheets[!grepl("^_", sheets)] if (!length(sheets)) stop("sheets has no length\nHINT: ", if(skipSheetsStartingWithUnderscore) "Try setting skipSheetsStartingWithUnderscore=FALSE\n Also ", "check getSheets(wb)") selfname_ (sheets) if (length(startCol) > 1 || length(startRow) > 1) { stop ("arguments 'startCol' and 'startRow' are not yet vectoriezed.\nTry using sheet names after selfname_()?") } ## Only apply the prefix if (1) it is explicit or (2) we are assigning the sheets as standalone DTs ## remove starting "X"s if there is prefix if (!missing(nm.prefix) || isTRUE(assignToEnvir)) { sheets.cleannames <- make.names(gsub(" ", "_", sheets)) ## remove the starting "X" when sheets starts with a number, such as 2014 sheets.cleannames <- ifelse(nchar(nm.prefix) & grepl("^[0-9]", sheets), sub("^X", "", sheets.cleannames), sheets.cleannames) nms <- paste0(nm.prefix, make.names(gsub(" ", "_", sheets))) } else nms <- sheets ## Check the names now so that we do not waste cycles reading and then failing because object exists if (isTRUE(assignToEnvir) && any(wh <- sapply(nms, exists, envir=envir))) { if (!overwrite.if.exists) stop(warningCols("The following DTs or objects already exist in the target envir", nwhich(wh), post="HINT: set flag overwrite.if.exists=TRUE")) if (warn.if.exists) warning(warningCols("The following DTs or objects already exist in the target envir and will be overwritten", nwhich(wh))) ## wait a sec to give user the chance to manually break Sys.sleep(1.5) } ## Whether or not to suppressWarnings func.suppress <- {if (showWarnings) identity else suppressWarnings} # verboseMsg(verbose, sprintf(" --- reading sheet --- ", s), time=FALSE, endl=0) verboseMsg(verbose, sprintf("%48s", " ------ READING SHEET ------ "), time=FALSE, endl=1) ## Read each sheet DT.raw_from_sheets <- lapply(sheets, function(s) { ## Java Garbage Collection jgc() # verboseMsg(verbose, sprintf("reading sheet %15s : ", s), time=FALSE, endl=0) verboseMsg(verbose, sprintf("%25s : ", s), time=FALSE, endl=0) ## debugging browser(expr=inDebugMode(c("readWorksheet")), text="in XLStoDT() INSIDE lapply()") ret <- try(func.suppress( readWorksheet(wb, sheet=unname(s), startCol=startCol, startRow=startRow, check.names=check.names, useCachedValues=useCachedValues) ), silent=TRUE) if (!isErr(ret)) { ret <- as.data.table(ret) verboseMsg(verbose && nrow(ret), dim2txt(ret), time=FALSE) if (sheetAsCol && "sheetSource" %chin% names(ret)) warning ("sheet '", s, "' already has a column named 'sheetSource' -- will not add the sheet info") else if (!nrow(ret)) verboseMsg(verbose, "[ IS EMPTY ]", time=FALSE) else if (sheetAsCol) ret[, sheetSource := s] } else { verboseMsg(verbose, "[ FAILED ]", time=FALSE) } return(ret) }) ## // end lapply ## Check for failures if (any (Errors <- sapply(DT.raw_from_sheets, isErr))) warning("The following sheets could not be read", sprintf("\n%12s : %s", sheets[Errors], parseError.xlconnect(DT.raw_from_sheets[Errors]))) ## assign the names that were computed earlier data.table::setattr(DT.raw_from_sheets, "names", nms) ## Drop any errors if (discardErrors) DT.raw_from_sheets <- DT.raw_from_sheets[sapply(DT.raw_from_sheets, Negate(isErr))] # Drop any 0-column sheet if (discardEmptySheets) DT.raw_from_sheets <- DT.raw_from_sheets[sapply(DT.raw_from_sheets, ncol) > 0] if (simplify && areEqual(lapply(DT.raw_from_sheets, names))) { DT.nm <- make.names(gsub(" ", "_", (gsub("\\.xls(x)?$", "", basename(f))))) DT.raw_from_sheets <- list(rbindlist(DT.raw_from_sheets)) data.table::setattr(DT.raw_from_sheets, "names", DT.nm) } if (assignToEnvir) { for (nm in names(DT.raw_from_sheets)) assign(nm, DT.raw_from_sheets[[nm]], envir=envir) } ## After assigning, if simplifying and is only one table, remove it from list if (simplify && length(DT.raw_from_sheets) == 1 && is.data.table(DT.raw_from_sheets[[1]])) return(invisible(DT.raw_from_sheets[[1]])) return(invisible(DT.raw_from_sheets)) } parseError.xlconnect <- function(e) { if (is.list(e)) return (sapply(e, parseError.xlconnect)) msg <- trim(as.character(e)) if (grepl("Sheet index \\(-1\\) is out of range", e)) msg <- "Sheet not found" msg <- gsub("Error : IllegalArgumentException (Java): ", "", msg, fixed=TRUE) return(msg) }