Question

这是拉出按钮的代码：

Sub a()
    Dim btn As Button 
    Application.ScreenUpdating = False
    ActiveSheet.Buttons.Delete
    Dim t As Range


        For i = 1 To 3
        Set t = ActiveSheet.Range(Cells(i, 3), Cells(i, 3))
        Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)
        With btn
         .OnAction = "btnS"
         .Caption = "Btn " & i
         .Name = "Btn" & i
   End With
Next i

Application.ScreenUpdating = True

End Sub

Sub btnS()
    MsgBox Application.Caller
End Sub

这是发送群发电子邮件的代码：

Sub SendEmail(address_mail As String, subject_mail As String, mail_body As String)


Dim olApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application")

    Dim olMail As Outlook.MailItem
    Set olMail = olApp.CreateItem(olMailItem)

    olMail.To = address_mail
    olMail.Subject = subject_mail
    olMail.Body = mail_body

   On Error GoTo Cancel

    olMail.Send

Cancel:

End Sub
Sub SendMassEmail()

Dim addressString As String
addressString = ""
row_number = 2



Do
DoEvents

    row_number = row_number + 1
    addressString = addressString & Application.ActiveSheet.Range("C" & row_number) & ";"


    Loop Until row_number = 999
Call SendEmail(addressString, Application.ActiveSheet.Range("F9"), Application.ActiveSheet.Range("F10"))

End Sub

Answer 1

我真的不明白你为什么要将这两个代码绑定到一个代码中。如果你能澄清一点，我们将不胜感激。

因为只要两个代码都在同一个模块中，您就可以创建一个新子并在需要时运行它，这将一个接一个地运行您的代码：

Sub Bind()
Call a ' runs the first code
Call SendEmail ' runs the sendemail code
Call SendMassEmail ' runs the sendmassemail code
End Sub

以上将依次运行所有三个代码。您可以根据需要随意更改订单。

修改

好的，从我对你的评论中所理解的情况来看，你想要一个创建 1按钮的子版本，点击后会发送电子邮件。

假设您的第二个代码一切正常，这就是您所做的：

Sub a() Dim btn As Button Application.ScreenUpdating = False ActiveSheet.Buttons.Delete Dim t As Range r = 1 ' select the row number where you want to create the button c = 3 ' select the column number where you want to create the button Set t = ActiveSheet.Range(Cells(r, c), Cells(r, c)) Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height) With btn .OnAction = ActiveSheet.Name & ".SendEmail" ' select the name of your second code here. .Caption = "Btn" .Name = "Btn" End With Application.ScreenUpdating = True End Sub

这样就可以在活动工作表上创建一个按钮，单击该按钮将运行您需要的第二个代码（如果您的第二个代码也在同一个工作表中）。

我相信这就是你要找的东西！＆＃39;

编辑2：

从你的评论看来，你所追求的是一个简单的邮件合并。如果是这样，那么请阅读更多关于＆＃34;邮件合并＆＃34;因为它更容易提供更多功能。

你所要求的可以在excel中完成，但它要复杂得多，这就是：

创建2张:( Sheet1）名称＆amp;电子邮件（Sheet2）主题＆amp;体

在工作表上添加ActiveX按钮：主题＆amp;体

看起来如下所示：

Sheet1 http://im63.gulfup.com/Bp8nJx.png Sheet2 http://im63.gulfup.com/PtKK46.png

最后将以下代码添加到您的按钮：

Private Sub CommandButton1_Click() LastRow = Sheet1.Cells(Sheet1.Rows.Count, "B").End(xlUp).Row 'find the last filled row with emails For Each Cell In Worksheets("Names & Emails").Range("B2:B" & LastRow) 'sets the range of cells with emails If Cell.Value = "" Then GoTo Line1 'loop until a blank cell is reached i.e. lastrow x = x & Cell.Value & "; " 'appends all the email in one line while adding "; " in between Next Emails = Left([x], Len([x]) - 2) 'removes the last 2 characters ("; ") from the appended string as the seperator is not needed after the last email Line1: Dim OutApp As Object Dim OutMail As Object Dim strbody As String Set OutApp = CreateObject("Outlook.Application") Set OlObjects = OutApp.GetNamespace("MAPI") Set OutMail = OutApp.CreateItem(olMailItem) On Error Resume Next With OutMail .To = Emails 'inserts the appended line in the To field .Subject = Worksheets("Subject & Body").Range("B2").Value 'uses the value of B2 as the Subject of the Email .Body = Worksheets("Subject & Body").Range("B5").Value 'uses the value of B5 as the Body of the Email '.Display 'you can enable this line if you need to view the email before it's sent .Send 'sends the email End With x = "" End Sub

现在，只要您点击该按钮，它就会向列表中的所有地址发送一封电子邮件，其中包含您要选择的主题和正文。

可以任何人帮助我如何绑定自动提取按钮的代码和发送大量电子邮件的代码

1 个答案: