R/mail.R

In msberends/certedata: Tools for Data Analysis at Certe

# ==================================================================== #
# TITLE                                                                #
# Tools for Data Analysis at Certe                                     #
#                                                                      #
# AUTHORS                                                              #
# Berends MS (m.berends@certe.nl)                                      #
# Meijer BC (b.meijer@certe.nl)                                        #
# Hassing EEA (e.hassing@certe.nl)                                     #
#                                                                      #
# COPYRIGHT                                                            #
# (c) 2019 Certe Medische diagnostiek & advies - https://www.certe.nl  #
#                                                                      #
# LICENCE                                                              #
# This R package is free software; you can redistribute it and/or      #
# modify it under the terms of the GNU General Public License          #
# version 2.0, as published by the Free Software Foundation.           #
# This R package is distributed in the hope that it will be useful,    #
# but WITHOUT ANY WARRANTY; without even the implied warranty of       #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the         #
# GNU General Public License for more details.                         #
# ==================================================================== #

#' Verzend e-mails via R
#' @param body Tekst van de e-mail.
#' @param subject Onderwerp van de e-mail.
#' @param to Geaddresseerde (veld 'Aan') van de e-mail. Kan ook vector zijn. Standaard het e-mailadres zoals gedefinieerd in de omgevingsvariabele van de ingelogde gebruiker.
#' @param attachment Bijlagen: vector van locaties.
#' @param send Direct versturen van de e-mail. Met \code{send = FALSE} wordt de e-mail op het scherm weergegeven. Standaard \code{TRUE} bij niet-interactieve sessies.
#' @param cc Geaddresseerde (veld 'CC') van de e-mail. Kan ook vector zijn.
#' @param bcc Geaddresseerde (veld 'BCC') van de e-mail. Kan ook vector zijn.
#' @param priority Prioriteit van de e-mail: 0 = laag, 1 = normaal, 2 = hoog.
#' @param html_body Tekst van de e-mail als HTML opmaken (standaard: \code{TRUE}).
#' @param signature Handtekening aan e-mail toevoegen (standaard: \code{TRUE}). Werkt alleen als \code{html_body = TRUE}.
#' @param automated_notice Onderaan de mail deze tekst weergeven: "\emph{Deze mail is geautomatiseerd verstuurd.}" (standaard: \code{TRUE}).
#' @details Deze functie is afhankelijk van Outlook op Windows en gebruikt daarvan de eerste account.
#' @export
mail <- function(body = NULL,
                 subject = NULL,
                 to = Sys.getenv("R_USERMAIL"),
                 cc = NULL,
                 bcc = NULL,
                 attachment = NULL,
                 send = TRUE,
                 priority = 1,
                 html_body = TRUE,
                 signature = TRUE,
                 automated_notice = TRUE) {
  
  if (!"RDCOMClient" %in% rownames(installed.packages())) {
    stop("This function requires the RDCOMClient package")
  }
  
  require(RDCOMClient)
  
  tryCatch(outlook_app <- COMCreate("Outlook.Application"),
           error = function(e) stop("This function requires Outlook on Windows.\n", e$message))
  new_mail <- outlook_app$CreateItem(0) # 0 = mail
  
  # Geaddresseerden ----
  new_mail[["to"]] <- checkmailaddress(to)
  if (!is.null(cc)) {
    new_mail[["cc"]] <- checkmailaddress(cc)
  }
  if (!is.null(bcc)) {
    new_mail[["bcc"]] <- checkmailaddress(bcc)
  }
  
  # Onderwerp ----
  new_mail[["subject"]] <- ifelse(is.null(subject), "", subject)
  
  # Hoofdtekst ----
  body <- ifelse(is.null(body), "", body)
  if (html_body == TRUE) {
    if (automated_notice == TRUE) {
      body <- paste0(body, "<br><br><i>Deze mail is geautomatiseerd verstuurd.</i>", collapse = "")
    }
    if (signature == TRUE) {
      new_mail$GetInspector()
      body <- paste0(body, new_mail[["HTMLBody"]], collapse = "")
    }
    # altijd Calibri met 11pt
    body <- paste0('<div style="font-family: Calibri; font-size: 11pt;">', body, "</div>", collapse = "")
    new_mail[["HTMLBody"]] <- body
    
  } else {
    if (automated_notice == TRUE) {
      body <- paste0(body, "\n\nDeze mail is geautomatiseerd verstuurd.", collapse = "")
    }
    new_mail[["body"]] <-body
  }
  
  # Bijlagen ----
  if (!is.null(attachment)) {
    for (i in 1:length(attachment)) {
      if (!file.exists(attachment[i])) {
        warning("File does not exist: ", attachment[i])
        next
      }
      add <- new_mail[["attachments"]]$Add(gsub("/", "\\\\", attachment[i]))
    }
  }
  
  # Prioriteit ----
  new_mail[["importance"]] <- priority
  
  # Verzenden ----
  if (send == TRUE) {
    success <- new_mail$Send()
    if (!isTRUE(success)) {
      stop("Error while sending email")
    }
  } else {
    new_mail$Display()
    base::invisible()
  }
}

checkmailaddress <- function(x) {
  for (i in 1:length(x)) {
    if (!x[i] %like% "^[a-z0-9.-]+@[a-z0-9]+[a-z0-9.-]+[.][a-z]+$") {
      stop("Invalid email address: '", x, "'")
    }
  }
  paste(x, collapse = "; ")
}