Question

我需要结合InputBox任务的帮助。分析该单元格中的值之后，此代码将为该列中的每个单元格发送电子邮件。我创建了一个输入框，该框将询问用户的电子邮件和密码以及收件人的电子邮件。

我应该如何设置...当它想发送小于4的那些单元格的电子邮件时，它会提示所有输入框。然后，当要发送大于6的那些内容时，它将再次提示所有InputBox。对于少于7但大于3的那些代码也是如此。如何合并代码以使用相同的InputBox集？这就是我将InputBoxes组合在一起的意思。

Option Explicit
Public Sub LoopCells()

Dim c As Range

For Each c In Range("G2:G1048576")
    If c.Value <> "" And c.Value < 4 Then
      SendGmail c, 1
    End If
Next c

For Each c In Range("G2:G1048576")
    If c.Value <> "" And c.Value > 6 Then
      SendGmail c, 2
    End If
Next c

For Each c In Range("G2:G1048576")
    If c.Value <> "" And c.Value < 7 And c.Value > 3 Then
      SendGmail c, 3
    End If
Next c

End Sub


Function SendGmail(lowCell As Range, levelOfImportance As Integer)

On Error Resume Next
   'creating a CDO object
   Dim senderUserName As String
   Dim senderPassword As String
   Dim Mail As CDO.Message
   Set Mail = New CDO.Message

   'Enable SSL Authentication
   Mail.Configuration.Fields.Item _
   ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True

   'Make SMTP authentication Enabled=true (1)
   Mail.Configuration.Fields.Item _
   ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1

   'Set the SMTP server and port Details
   'Get these details from the Settings Page of your Gmail Account
   Mail.Configuration.Fields.Item _
   ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = _
   "smtp.gmail.com"
   Mail.Configuration.Fields.Item _
   ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
   Mail.Configuration.Fields.Item _
   ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    senderUserName = InputBox("Please Enter Sender's Gmail Address" & vbNewLine & "This field is compulsory! If you do not fill in all compulsory fields (correctly), the emails won't be sent")
    senderPassword = InputBox("Please Enter Sender's Gmail Password" & vbNewLine & "This field is compulsory! If you do not fill in all compulsory fields (correctly), the emails won't be sent")
   'Set your credentials of your Gmail Account
   Mail.Configuration.Fields.Item _
   ("http://schemas.microsoft.com/cdo/configuration/sendusername") = senderUserName
   Mail.Configuration.Fields.Item _
   ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = senderPassword

   'Update the configuration fields
   Mail.Configuration.Fields.Update


   'Set All Email Properties
   With Mail
      .Subject = "Update on transfusion product (EMERGENCY!!)"
      .From = senderUserName
      .To = InputBox("Enter Recipient Email Address" & vbNewLine & "This field is compulsory! If you do not fill in all compulsory fields (correctly), the emails won't be sent" & vbNewLine & "If you need to send to more than one recipient in this field, just type ; followed by the next email.")
      .CC = InputBox("Enter CC Recipient Email Address" & vbNewLine & "This field is optional! If you do not need to type anything, just press ok" & vbNewLine & "If you need to send to more than one recipient in this field, just type ; followed by the next email.")
      .BCC = InputBox("Enter BC Recipient Email Address" & vbNewLine & "This field is optional! If you do not need to type anything, just press ok" & vbNewLine & "If you need to send to more than one recipient in this field, just type ; followed by the next email.")
      Select Case levelOfImportance
Case Is = 1
 .TextBody = "Product has reached a critical value of " & lowCell.Value
Case Is = 2
 .TextBody = "Product has reached a Normal value of " & lowCell.Value
Case Is = 3
 .TextBody = "Product has reached a Minmum value of " & lowCell.Value
Case Else
 .TextBody = "Product has reached an Undefined value of " & lowCell.Value
End Select
   End With
   'to send the mail
   Mail.Send

End Function

Answer 1

这是基本概念：

Public Sub LoopCells()
   Dim senderUserName As String
   Dim senderPassword As String
   Dim recipTo As String
   Dim recipCC As String
   Dim recipBC As String
   Dim c As Range

   senderUserName = InputBox("Please Enter Sender's Gmail Address" & vbNewLine & "This field is compulsory! If you do not fill in all compulsory fields (correctly), the emails won't be sent")
   senderPassword = InputBox("Please Enter Sender's Gmail Password" & vbNewLine & "This field is compulsory! If you do not fill in all compulsory fields (correctly), the emails won't be sent")
   recipTo = InputBox("Enter Recipient Email Address" & vbNewLine & "This field is compulsory! If you do not fill in all compulsory fields (correctly), the emails won't be sent" & vbNewLine & "If you need to send to more than one recipient in this field, just type ; followed by the next email.")
   recipCC = InputBox("Enter CC Recipient Email Address" & vbNewLine & "This field is optional! If you do not need to type anything, just press ok" & vbNewLine & "If you need to send to more than one recipient in this field, just type ; followed by the next email.")
   recipBC = InputBox("Enter BC Recipient Email Address" & vbNewLine & "This field is optional! If you do not need to type anything, just press ok" & vbNewLine & "If you need to send to more than one recipient in this field, just type ; followed by the next email.")

   For Each c In Range("G2:G1048576")
       If c.Value <> "" And c.Value < 4 Then
         SendGmail senderUserName, senderPassword, recipTo, recipCC, recipBC, c, 1
       End If
   Next c

   For Each c In Range("G2:G1048576")
       If c.Value <> "" And c.Value > 6 Then
         SendGmail senderUserName, senderPassword, recipTo, recipCC, recipBC, c, 2
       End If
   Next c

   For Each c In Range("G2:G1048576")
       If c.Value <> "" And c.Value < 7 And c.Value > 3 Then
         SendGmail senderUserName, senderPassword, recipTo, recipCC, recipBC, c, 3
       End If
   Next c
End Sub

然后在SendGmail中，您将删除InputBox并使用传递到函数中的变量。

Function SendGmail(senderUserName As String, senderPassword As String, recipTo As String, recipCC As String, recipBC As String, lowCell As Range, levelOfImportance As Integer)

End Function

Answer 2

哦，我明白了！我设法完成了解决方案。非常感谢：）

Option Explicit
Public Sub LoopCells()


   Dim senderUserName As String
   Dim senderPassword As String
   Dim recipTo As String
   Dim recipCC As String
   Dim recipBC As String
   Dim c As Range

   senderUserName = InputBox("Please Enter Sender's Gmail Address" & vbNewLine & "This field is compulsory! If you do not fill in all compulsory fields (correctly), the emails won't be sent")
   senderPassword = InputBox("Please Enter Sender's Gmail Password" & vbNewLine & "This field is compulsory! If you do not fill in all compulsory fields (correctly), the emails won't be sent")
   recipTo = InputBox("Enter Recipient Email Address" & vbNewLine & "This field is compulsory! If you do not fill in all compulsory fields (correctly), the emails won't be sent" & vbNewLine & "If you need to send to more than one recipient in this field, just type ; followed by the next email.")
   recipCC = InputBox("Enter CC Recipient Email Address" & vbNewLine & "This field is optional! If you do not need to type anything, just press ok" & vbNewLine & "If you need to send to more than one recipient in this field, just type ; followed by the next email.")
   recipBC = InputBox("Enter BC Recipient Email Address" & vbNewLine & "This field is optional! If you do not need to type anything, just press ok" & vbNewLine & "If you need to send to more than one recipient in this field, just type ; followed by the next email.")

   For Each c In Range("G2:G1048576")
       If c.Value <> "" And c.Value < 4 Then
         SendGmail senderUserName, senderPassword, recipTo, recipCC, recipBC, c, 1
       End If
   Next c

   For Each c In Range("G2:G1048576")
       If c.Value <> "" And c.Value > 6 Then
         SendGmail senderUserName, senderPassword, recipTo, recipCC, recipBC, c, 2
       End If
   Next c

   For Each c In Range("G2:G1048576")
       If c.Value <> "" And c.Value < 7 And c.Value > 3 Then
         SendGmail senderUserName, senderPassword, recipTo, recipCC, recipBC, c, 3
       End If
   Next c
End Sub

Function SendGmail(senderUserName As String, senderPassword As String, recipTo As String, recipCC As String, recipBC As String, lowCell As Range, levelOfImportance As Integer)



On Error Resume Next
   'creating a CDO object
   Dim Mail As CDO.Message
   Set Mail = New CDO.Message

   'Enable SSL Authentication
   Mail.Configuration.Fields.Item _
   ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True

   'Make SMTP authentication Enabled=true (1)
   Mail.Configuration.Fields.Item _
   ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1

   'Set the SMTP server and port Details
   'Get these details from the Settings Page of your Gmail Account
   Mail.Configuration.Fields.Item _
   ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = _
   "smtp.gmail.com"
   Mail.Configuration.Fields.Item _
   ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
   Mail.Configuration.Fields.Item _
   ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
   'Set your credentials of your Gmail Account
   Mail.Configuration.Fields.Item _
   ("http://schemas.microsoft.com/cdo/configuration/sendusername") = senderUserName
   Mail.Configuration.Fields.Item _
   ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = senderPassword

   'Update the configuration fields
   Mail.Configuration.Fields.Update


   'Set All Email Properties
   With Mail
      .Subject = "Update on transfusion product (EMERGENCY!!)"
      .From = senderUserName
      .To = recipTo
      .CC = recipCC
      .BCC = recipBC
      Select Case levelOfImportance
Case Is = 1
 .TextBody = "Product has reached a critical value of " & lowCell.Value
Case Is = 2
 .TextBody = "Product has reached a Normal value of " & lowCell.Value
Case Is = 3
 .TextBody = "Product has reached a Minmum value of " & lowCell.Value
Case Else
 .TextBody = "Product has reached an Undefined value of " & lowCell.Value
End Select
   End With
   'to send the mail
   Mail.Send

End Function

用于从Gmail发送电子邮件的InputBox

2 个答案: