此代码正常工作,并将整个工作簿发送到我的电子邮件收件人列表,但我发现它还发送电子邮件到随机内部电子邮件地址,列表中没有列表或代码。有人知道它可能会这样做吗?
Sub Send_Reports()
Dim wb1 As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim OutApp As Object
Dim OutMail As Object
Dim X As Integer
Dim Analyst_Count As Integer
Dim Analyst_Email As String
Analyst_Count = ActiveWorkbook.Worksheets("Dashboard").Range("C27", Worksheets("Dashboard").Range("C27").End(xlDown)).Rows.Count
For X = 1 To Analyst_Count
With Worksheets("Dashboard")
Analyst_Email = Range("C27").Offset(X - 1, 0)
Application.StatusBar = " Emailing: " & Analyst_Email
End With
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set wb1 = ActiveWorkbook
TempFilePath = Environ$("temp") & "\"
TempFileName = "Copy of " & wb1.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))
wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = (Analyst_Email)
.CC = ""
.BCC = ""
.Subject = "New Open Req Report"
.Body = "Here is the Open Req Report broken down by function."
.Attachments.Add TempFilePath & TempFileName & FileExtStr
.Send
End With
On Error GoTo 0
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Next X
Application.StatusBar = False
End Sub