0

脚本目标
将两封电子邮件中的附件文件 (.xlsx) 保存到网络共享。

下面的问题
R 脚本在 RStudio 中运行良好，但在从 Windows 命令提示符运行时失败。

错误信息

< checkErrorInfo> 80020009
不支持 InterfaceSupportsErrorInfo
checkErrorInfo -2147352567
错误：发生异常。
执行停止

代码

cat("\n##########################################################################################",
    "\n", format(Sys.time(), "%a %m/%d/%Y %X"), ": Starting Daily Attachment Save Script...",
    "\n##########################################################################################")

cat("\n", format(Sys.time(), "%a %m/%d/%Y %X"), ": Setting variables/constants/functions... ")

  library("RDCOMClient")
  library("lubridate")

  TodaysDate  <- Sys.Date()
  StartTime   <- Sys.time()
  currentUser <- Sys.getenv("USERNAME")
  tmpDir      <- Sys.getenv("TEMP")
  report_run_date_main <- Sys.Date()

  SendMail <- function(outFile,
                       ToEmail,
                       EmailSubject,
                       EmailBody,
                       AttachFile = TRUE,
                       CC = "me@me.com;"){

    OutApp <- COMCreate("Outlook.Application")
    outMail = OutApp$CreateItem(0)

    outMail[["sentonbehalfofname"]] = "me@me.com"
    outMail[["To"]] = ToEmail
    outMail[["CC"]] = CC
    outMail[["subject"]] = EmailSubject
    outMail[["HTMLBody"]] = paste0("<p>**** SYSTEM GENERATED EMAIL ****</p><br><p>", EmailBody, "</p>", sep = "")
    if (AttachFile == TRUE) {
      outMail[["Attachments"]]$Add(outFile)
    }
    outMail$Send()
    outMail <- NULL
    OutApp <- NULL
  }

  outlook_app <- COMCreate("Outlook.Application")
  search <- outlook_app$AdvancedSearch(
    "Inbox", paste0("(urn:schemas:httpmail:subject like 'EMAIL SUBJECT TO SEARCH%')")
  )
  results <- search$Results()

  save_folder <- paste0(Sys.getenv("USERPROFILE"), "\\Documents")

  get_attachment_names <- function(email) {
    number_attachments = email$Attachments()$Count()
    if (number_attachments == 0) {
      return("")
    }
    attachments <- purrr::map(
      seq(number_attachments), 
      function(x) email$Attachments(x)$FileName()
    )
    return(paste(attachments, sep = ", "))
  }

  msg1 <- ""
  msg2 <- ""

cat("done.")

cat("\n", format(Sys.time(), "%a %m/%d/%Y %X"), ": Saving attachemnts from daily emails... ") 
  for (i in 1:results$Count()) {
    # Error on next line, when run using command line
    gmt_date <- results$Item(i)$ReceivedTime()
    date_received <- as.POSIXct(gmt_date * (24 * 60 * 60), origin="1899-12-30", tz="GMT")

    date_received_dt <- format(date_received, "%Y-%m-%d")
    date_received_tm <- format(date_received, "%H:%M:%S %P")
    date_received_hr <- format(date_received, "%H")

    if(date_received >= Sys.Date()-1) {
      if(date_received_dt==Sys.Date()-1){
        if(date_received_hr>=16){
          email <- results$Item(i)
          attachment_file <- get_attachment_names(email)
          email$Attachments(1)$SaveAsFile(paste0(save_folder, attachment_file))
          msg1 <- paste(format(Sys.time(), "%a %m/%d/%Y %X"), 
                        "<br><br><b>Attachment name:</b>", attachment_file ,
                        "<br><b>Email received on:</b>", date_received, 
                        "<br><b>Subject:</b>", email$Subject(),
                        "<br><b>Save folder:</b>", save_folder)
        }
      } else{
        email <- results$Item(i)
        attachment_file <- get_attachment_names(email)
        email$Attachments(1)$SaveAsFile(paste0(save_folder, attachment_file))
        msg2 <- paste(format(Sys.time(), "%a %m/%d/%Y %X"), 
                      "<br><br><b>Attachment name:</b>", attachment_file ,
                      "<br><b>Email received on:</b>", date_received, 
                      "<br><b>Subject:</b>", email$Subject(),
                      "<br><b>Save folder:</b>", save_folder)
      }
    }
  }
cat("done.")


cat("\n", format(Sys.time(), "%a %m/%d/%Y %X"), ": Notifying users of attachment save status... ")
  if((nchar(msg1)==0)){
    SendMail(outFile = "",
             ToEmail = "me@me.com",
             EmailSubject = paste("[Action Required] Daily Attachment Save Error", Sys.Date()),
             EmailBody = paste("Helpful text 1 for troubleshooting"),
             AttachFile = F, CC = "")
  } else {
    SendMail(outFile = "",
             ToEmail = "users@many.com",
             EmailSubject = paste("Daily attachment saved", Sys.Date()),
             EmailBody = paste(msg1),
             AttachFile = F, CC = "")
  }

  if(nchar(msg2)==0){
    SendMail(outFile = "",
             SendMail(outFile = "",
             ToEmail = "me@me.com",
             EmailSubject = paste("[Action Required] Daily Attachment Save Error", Sys.Date()),
             EmailBody = paste("Helpful text 2 for troubleshooting"),
             AttachFile = F, CC = "")
  } else {
    SendMail(outFile = "",
             ToEmail = "users@many.com",
             EmailSubject = paste("Daily attachment saved", Sys.Date()),
             EmailBody = paste(msg2),
             AttachFile = F, CC = "")
  }
cat("done.")

cat("\n", format(Sys.time(), "%a %m/%d/%Y %X"), ": Garbage Collection... ")
  rm(list=ls())
cat("done.")

cat("\n########################################################################################",
    "\n", format(Sys.time(), "%a %m/%d/%Y %X"), ": Daily Attachment Save Script complete.",
    "\n########################################################################################")

R脚本执行命令

C:\Progra~1\R\R-3.4.4\bin\i386\Rscript.exe --no-save --no-restore --verbose C:\Attachments_Save_Script.R > "C:\LOGS\L%日期：~-4,4%%日期：~-7,2%%日期：~-10,2% %时间：~0,2%%时间：~3,2%%时间：~6,2% .log" 2> "C:\LOGS\E%date:~-4,4%%date:~-7,2%%date:~-10,2% %time:~0,2%%time: ~3,2%%时间：~6,2%.log"

版本信息
Windows 10 Pro 64 位（具有 16 GB RAM 的 i7 vPro）
R 版本 3.4.4 (2018-03-15) -- "Someone to Lean On"
Microsoft Outlook 2013 (15.0.5172.1000) MSO (15.0.5172.1000) 32 -位
RStudio 1.0.143

问
有没有人在命令行中遇到过 RDCOMClient 库的这个问题？有解决办法吗？谢谢你。

4

1 回答 1

0

你的代码从不检查你是否真的有一个MailItem对象——你也可以有ReportItem和MeetingItem对象，它们不暴露ReceivedTime属性。检查Class属性（所有OOM对象暴露）== 43（OlObjectClass.olMail）

于 2020-02-20T22:33:16.227 回答