Question

我是一名在医院工作的欧洲实习生。我的日常工作是在需要护士，医生或外科医生时找到替代品。为此，我收到某个部门的请求，其形式为excel电子表格，其中包含4个不同的属性，用于确定所需人员的时间，部门和具体类型。

根据该信息，我查看了一个固定数据库，该数据库也基于excel电子表格，适用于符合要求的人。

在我发送电子邮件/短信或致电部门负责人获得批准后，答复几乎总是肯定。

收到确认后，我将更换的信息发送给需要更换的部门，然后我的工作就完成了。我每天要做大约150个这样的请求，如果我可以为此编写一个程序，我就可以为医院节省很多纳税人的钱，因为他们聘请了3个其他人来完成这项工作。

因此，我的问题： 编写此程序的最佳语言是什么？

您是否会推荐一种脚本语言，可以更轻松地访问文件和发送电子邮件？或者我们对这项任务太弱了？

语言要求如下：

访问Excel电子表格
阅读电子表格并复制单元格数组中的值
在电子表格中查找值
使用我在Excel电子表格搜索中获得的值发送电子邮件？
阅读电子邮件，如果值= =是，请执行...否则执行...
最后，向xxx人发送包含xxxxx信息的电子邮件

如果我使用的是mac，我会使用像applescript这样的脚本语言与automator一起访问并阅读excel文件并发送电子邮件/短信。

先谢谢你的帮助。

Answer 1

以下代码距离完整解决方案还有很长的路要走。其目的是让您开始考虑系统的运行方式。

展望未来，我设想需要一个名为 HumanActionRequired.txt 的文本文件。第十行代码是一个常量，指定将在其中创建此文件的文件夹。您必须将“C：\ DataArea \ Play”替换为系统上文件夹的名称。您可能希望重命名该文件：请参阅第六行。

虽然我设想此文件是错误消息的目标，但我在此处使用它来列出InBox中消息的详细信息。我只输出了一小部分可用的属性，但它应该让你考虑可能的内容。

以下代码属于OutLook中的模块：

打开Outlook。
选择工具，宏和安全。您需要将安全级别设置为“中”。稍后您可以与IT部门讨论获取宏的可信任状态，但现在这样做。
选择“工具”，“宏”和“Visual Basic编辑器”，或单击“Alt + F11”。
您可能会在左侧看到Project Explorer（如果没有，则显示Control + R）。如果您从未创建过Outlook宏，则右侧区域将为灰色。
选择“插入”，“模块”。灰色区域将变为白色，上方的代码区域和下方的立即窗口。
将以下代码复制到代码区域。

将光标定位在宏 LocateInterestingEmails（）中，然后单击F5。您将收到警告，宏正在尝试访问您的电子邮件。勾选允许访问并选择时间限制，然后单击是。宏将把收件箱中电子邮件的选定属性写入文件 HumanActionRequired.txt 。

Option Explicit
Sub LocateInterestingEmails()

  Dim ErrorDescription As String
  Dim ErrorNumber As Long
  Static ErrorCount As Integer
  Const FileCrnt As String = "HumanActionRequired.txt"
  Dim FolderTgt As MAPIFolder
  Dim InxAttachCrnt As Long
  Dim InxItemCrnt As Long
  Dim OutputFileNum As Long
  Const PathCrnt As String = "C:\DataArea\Play"

  ErrorCount = 0
  OutputFileNum = 0

Restart:

  ' On Error GoTo CloseDown

  Set FolderTgt = CreateObject("Outlook.Application"). _
              GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

  OutputFileNum = FreeFile
  Open PathCrnt & "\" & FileCrnt For Append Lock Write As #OutputFileNum

  For InxItemCrnt = 1 To FolderTgt.Items.Count
    With FolderTgt.Items.Item(InxItemCrnt)

      If .Class = olMail Then
        Print #OutputFileNum, "-----------------------------"
        Print #OutputFileNum, "Subject: " & .Subject
        Print #OutputFileNum, "Sender: " & .SenderEmailAddress
        Print #OutputFileNum, "Recipient: " & .To
        Print #OutputFileNum, "Date sent: " & .SentOn
        If .Attachments.Count > 0 Then
          Print #OutputFileNum, "Attachments:"
          For InxAttachCrnt = 1 To .Attachments.Count
            Print #OutputFileNum, "  " & .Attachments(InxAttachCrnt).DisplayName
          Next
        End If
      End If
    End With
  Next

CloseDown:
  ErrorNumber = Err.Number
  ErrorDescription = Err.Description
  Err.Clear

  Set FolderTgt = Nothing

  If ErrorNumber <> 0 Then
    ' Here because of an error
    If OutputFileNum = 0 Then
      ' Output file not open
      OutputFileNum = FreeFile
      Open PathCrnt & "\" & FileCrnt For Append Lock Write As #OutputFileNum
    End If
    Print #OutputFileNum, "-----------------------------"
    Print #OutputFileNum, "Error at " & Now()
    Print #OutputFileNum, "Error number = " & ErrorNumber & _
                          "   description = " & ErrorDescription
  End If

  If OutputFileNum <> 0 Then
    ' File open
    Close OutputFileNum
    OutputFileNum = 0
  End If

End Sub

版本2

此版本包含第一个版本的代码加上：

它会打开一个现有工作簿，并保存有关所找到的Excel附件的信息。
它标识扩展名为xls?的附件，并根据收到的日期/时间和发件人姓名将其保存到光盘中。
打开每个保存的附件。对于已保存附件中的每个工作表，它会在现有工作簿中创建一行，其中包含文件名，发件人姓名和电子邮件地址，工作表名称以及单元格A1的值。

我认为此代码不会直接有用，但它会显示如何保存附件和打开工作簿以便读取或写入我认为您需要的内容。

我知道唯一缺少的代码是：

将已处理的电子邮件移至保存文件夹。
生成回复电子邮件。

但是，根据您希望如何自动化整个过程，可能需要更多代码。

下面的代码并不像我想的那样整洁。在你完全理解之前我不想再添加了。我还希望更好地了解您计划发送的电子邮件以及整个过程的所需自动化。

回过头来看看你不理解的代码的任何部分。

Option Explicit
Sub LocateInterestingEmails()

  ' I use constants to indentify columns in worksbooks because if I move the
  ' column I only need to update the constant to update the code.  I said the
  ' same in a previous answer and some one responded that they preferred
  ' Enumerations.  I use Enumerations a lot but I still prefer to use constants
  ' for column numbers.
  Const ColSumFileNameSaved As String = "A"
  Const ColSumFileNameOriginal As String = "B"
  Const ColSumSenderName As String = "C"
  Const ColSumSenderEmail As String = "D"
  Const ColSumSheet As String = "E"
  Const ColSumCellA1 As String = "F"

  ' You must change the value of this constant to the name of a folder on your
  ' computer.  All file created by this macro are written to this folder.
  Const PathCrnt As String = "C:\DataArea\Play"

  ' I suggest you change the values of these constants to
  ' something that you find helpful.
  Const FileNameHAR As String = "HumanActionRequired.txt"
  Const FileNameSummary As String = "Paolo.xls"

  Dim CellValueA1 As Variant
  Dim ErrorDescription As String
  Dim ErrorNumber As Long
  Dim FileNameReqDisplay As String
  Dim FileNameReqSaved As String
  Dim FolderTgt As MAPIFolder
  Dim InxAttachCrnt As Long
  Dim InxItemCrnt As Long
  Dim InxSheet As Long
  Dim OutputFileNum As Long
  Dim Pos As Long
  Dim ReceivedTime As Date
  Dim RowSummary As Long
  Dim SenderName As String
  Dim SenderEmail As String
  Dim SheetName As String
  Dim XlApp As Excel.Application
  Dim XlWkBkRequest As Excel.Workbook
  Dim XlWkBkSummary As Excel.Workbook

  ' Ensure resource controls are null before macro does anything that can cause
  ' an error so error handler knows if the resource is to be released.
  OutputFileNum = 0
  Set XlApp = Nothing
  Set XlWkBkRequest = Nothing
  Set XlWkBkSummary = Nothing

  ' Open own copy of Excel
  Set XlApp = Application.CreateObject("Excel.Application")
  With XlApp
    .Visible = True         ' This slows your macro but helps during debugging
    ' Open workbook to which a summary of workbooks extracted will be written
    Set XlWkBkSummary = .Workbooks.Open(PathCrnt & "\" & FileNameSummary)
    With XlWkBkSummary.Worksheets("Summary")
      ' Set RowSummary to one more than the last currently used row
      RowSummary = .Cells(.Rows.Count, ColSumFileNameSaved).End(xlUp).Row + 1
    End With
  End With

Restart:

  ' I prefer to have my error handler switched off during development so the
  ' macro stops on the faulty statement.  If you remove the comment mark from
  ' the On Error statement then any error will cause the code to junp to label
  ' CloseDown which is at the bottom of this routine.

  ' On Error GoTo CloseDown

  ' Gain access to InBox
  Set FolderTgt = CreateObject("Outlook.Application"). _
              GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

  ' Open text file for output.  I envisage this file being used for error
  ' messages but for this version of the macro I write a summary of the
  ' contents of the InBox to it.
  OutputFileNum = FreeFile
  Open PathCrnt & "\" & FileNameHAR For Output Lock Write As #OutputFileNum

For InxItemCrnt = 1 To FolderTgt.Items.Count
  With FolderTgt.Items.Item(InxItemCrnt)

    If .Class = olMail Then
      ' Only interested in mail items.  Most of the other items will be
      ' meeting requests.
      Print #OutputFileNum, "-----------------------------"
      Print #OutputFileNum, "Subject: " & .Subject
      ' Currently we are within With FolderTgt.Items.Item(InxItemCrnt).
      ' Values from this mail item are to be written to a workbook
      ' for which another With will be required.  Copy values to
      ' variables for they are accessable.
      ' Note: XlApp.XlWkBkSummary.Worksheets("Summary")
      '         .Cells(RowSummary, ColSumFileNameOriginal).Value = _
      '       FolderTgt.Items.Item(InxItemCrnt).Attachments(InxAttachCrnt) _
      '       .DisplayName
      ' is legal but is not very clear.  Code is much clearer will full use
      ' of With stateents even if it means values must be copied to variable.
      SenderName = .SenderName
      SenderEmail = .SenderEmailAddress
      ReceivedTime = .ReceivedTime
      Print #OutputFileNum, "SenderName: " & SenderName
      Print #OutputFileNum, "SenderAddr: " & SenderEmail
      Print #OutputFileNum, "Received: " & ReceivedTime
      Print #OutputFileNum, "Date sent: " & .SentOn
      If .Attachments.Count > 0 Then
        Print #OutputFileNum, "Attachments:"
        For InxAttachCrnt = 1 To .Attachments.Count
          With .Attachments(InxAttachCrnt)
            ' I cannot find an example for which the
            ' DisplayName and FileName are different
            FileNameReqDisplay = .DisplayName
            Print #OutputFileNum, "  " & FileNameReqDisplay & "|" & .FileName
            Pos = InStrRev(FileNameReqDisplay, ".")
            ' With ... End With and If ... End If must be properly nested.
            ' Within the If below I want access to the attachment and to the
            ' workbook.  Hence the need to terminate the current With and then
            ' immediately start it again within the If ... End If block.
          End With
          If LCase(Mid(FileNameReqDisplay, Pos + 1, 3)) = "xls" Then
            With .Attachments(InxAttachCrnt)
              ' Save the attachment with a unique name.  Note this will only be
              ' unique if you do not save the same attachment again.
              FileNameReqSaved = _
                   Format(ReceivedTime, "yyyymmddhhmmss") & " " & SenderName
              .SaveAsFile PathCrnt & "\" & FileNameReqSaved
            End With
            ' Open the saved attachment
            Set XlWkBkRequest = _
                         XlApp.Workbooks.Open(PathCrnt & "\" & FileNameReqSaved)
            With XlWkBkRequest
              'Examine every worksheet in workbook
              For InxSheet = 1 To .Worksheets.Count
                With .Worksheets(InxSheet)
                  ' Save sheet name and a sample value
                  SheetName = .Name
                  CellValueA1 = .Cells(1, 1).Value
                End With
                ' Save information about this sheet and its workbook
                With XlWkBkSummary.Worksheets("Summary")
                  .Cells(RowSummary, ColSumFileNameSaved).Value = _
                                                            FileNameReqSaved
                  .Cells(RowSummary, ColSumFileNameOriginal).Value = _
                                                          FileNameReqDisplay
                  .Cells(RowSummary, ColSumSenderName).Value = SenderName
                  .Cells(RowSummary, ColSumSenderEmail).Value = SenderEmail
                  .Cells(RowSummary, ColSumSheet).Value = SheetName
                  .Cells(RowSummary, ColSumCellA1).Value = CellValueA1
                  RowSummary = RowSummary + 1
                End With  ' XlWkBkSummary.Worksheets("Summary")
              Next InxSheet
              .Close SaveChanges:=False
              Set XlWkBkRequest = Nothing
            End With  ' XlWkBkRequest
          End If
        Next
      End If
    End If
  End With
Next

CloseDown:
ErrorNumber = Err.Number
ErrorDescription = Err.Description
Err.Clear

Set FolderTgt = Nothing

If ErrorNumber <> 0 Then
  ' Have reached here because of an error
  If OutputFileNum = 0 Then
    ' Output file not open
    OutputFileNum = FreeFile
    Open PathCrnt & "\" & FileNameHAR For Append Lock Write As #OutputFileNum
  End If
  Print #OutputFileNum, "-----------------------------"
  Print #OutputFileNum, "Error at " & Now()
  Print #OutputFileNum, "Error number = " & ErrorNumber & _
                        "   description = " & ErrorDescription
End If

' Release resources

If OutputFileNum <> 0 Then
  ' File open
  Close OutputFileNum
  OutputFileNum = 0
End If

If Not (XlWkBkRequest Is Nothing) Then
  XlWkBkRequest.Close SaveChanges:=False
  Set XlWkBkRequest = Nothing
End If

If Not (XlWkBkSummary Is Nothing) Then
  XlWkBkSummary.Close SaveChanges:=True
  Set XlWkBkSummary = Nothing
End If

If Not (XlApp Is Nothing) Then
  XlApp.Quit
  Set XlApp = Nothing
End If

End Sub

创建一个Windows应用程序，读取和写入Excel电子表格+读取和写入电子邮件

1 个答案: