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）中包含所有数据，以显示当前服务器硬盘空间。< / p>

这可能吗？

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

菲利普

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

1 个答案: