如何逐行读取 Excel 文件并将电子邮件发送到工作表上的姓名？

Question

我们有一个名为 empList.xlsx 的 Excel 文件，其中列出了服务器空间即将用尽的用户列表。

该邮件旨在告知用户当前空间状态并删除一些文件以释放一些空间。

下面的 VB 脚本只读取员工的电子邮件地址并向他们发送电子邮件通知，但不读取特定行的其余数据。

Set objExcel = CreateObject("Excel.Application")

Function getEmail()
    Dim iCol As Integer, iRow As Integer
    Dim sEmailBody As String
    Dim sEmailTo as string ' the recipient
    iCol = 1 ' column A
    iRow = 2 ' row 2

    Do
        sEmailTo = cells(irow, 1).text
        sEmailBody = sendData(iRow)
        iRow = iRow + 1
    Loop While Not Len(Trim(Cells(iRow, iCol))) = 0
End Function

Function sendData(ByVal iRow As Integer) As String
    Dim iCol As Integer

    For iCol = 2 To 11 ' B=2, K=11
        sendData = sendData & Cells(iRow, iCol).Text & vbCrLf
    Next

    MsgBox sendData
End Function

Set objExcel = CreateObject("Excel.Application")
Set objEmail = CreateObject("CDO.Message")
set objConf = CreateObject("CDO.Configuration")
Set objWorkbook = objExcel.Workbooks.Open _
   ("C:\Logs\EmpList.xlsx")

Set objFlds = objConf.Fields
With objFlds
  .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
  .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtprey.domain.com"
  .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
  '.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoAnonymous
  .Update
End With
Set objEmail.Configuration = objConf
x = 2
Do Until objExcel.Cells(x, 2).Value = ""
    Set objEmail.Configuration = objConf

    objEmail.From = "noReply@domain.com"
    objEmail.To = objExcel.Cells(x, 2)
    objEmail.Subject = "Your H Drive is Full"
    objEmail.Textbody = sendData(2)
    objEmail.Send
    x = x + 1
Loop
objExcel.Quit

下面是每一行的布局示例：

Jim.Brown@domain.com|H:\home\matt.tavakolian\|60.3 GB|54629.5 GB|2274|288|0.0 GB| 6.7%|3/4/2013 3:11 PM|3/11/2013 12:16 PM|9/23/2008 3:26 PM

由于我不知道添加附件的方法，因此我使用竖线 (|) 来表示每行每个单元格的数据。

上面的例子表示从 CellA 到 CellK 的第 2 行。

我们想做的是发送一封电子邮件给第 2 行的 Jim.Brown@domain.com，并包含该行的所有数据（从 CellA 到 CellK）以显示当前服务器硬盘空间。

这可能吗？

Answer 1

您可以尝试这样的事情（显然使用 Excel 对象和工作簿对象）：

Function getEmail()

Dim iCol As Integer, iRow As Integer
Dim sEmailBody As String
Dim sEmailTo as string ' the recipient
iCol = 1 ' column A
iRow = 2 ' row 2

Do
    sEmailTo=cells(irow,1).text
    sEmailBody = sendData(iRow)
    iRow = iRow + 1
Loop While Not Len(Trim(Cells(iRow, iCol))) = 0

End Function

在该函数中，您调用以下函数来获取电子邮件正文！

Function sendData(ByVal iRow As Integer) As String

Dim iCol As Integer

For iCol = 2 To 11 ' B=2, K=11
    sendData = sendData & Cells(iRow, iCol).Text & vbCrLf
Next

    MsgBox sendData

End Function

所以只需调用函数“getEmaily”来获取电子邮件地址和进入您的电子邮件正文的正文！

HTH

菲利普