Question

所以我有一项自动化的任务。我们有一个受保护的电子表格（用户只能阅读＆＃39;访问权限），以便管理员不时更新，以便从付费订阅邮件列表中添加/删除用户。我试图简化发送这些电子邮件的过程，以加快流程并消除人为错误的可能性。

因此，电子邮件地址列在＆＃39; C＆＃39;列，列表可以只有数万个，或者它可能只有1或2.工作簿有几个表单，用于指定订阅者订阅的数据集。所以我把一些有效的东西放在一起

'This function will grab the information the macro asks for
Function RangeToString(ByVal myRange As Range) As String
RangeToString = ""
If Not myRange Is Nothing Then
    Dim myCell As Range
    For Each myCell In myRange
        RangeToString = RangeToString & "; " & myCell.Value
    Next myCell
    'Remove extra comma
    RangeToString = Right(RangeToString, Len(RangeToString) - 1)
End If
End Function

Sub EmailTest1()
Dim OutApp As Object
Dim OutMail As Object
Dim strSubject As String
Dim myString As String
Dim rng As Range
Dim strCopy As String

'Sheet1 would be Sheet2/3/4/etc. depending on what list we're pulling from.
Set rng = Sheet1.Range("c2:c90000")
myString = RangeToString(rng)
strCopy = "internal.private@email.com; internal1.private@email.co; 
internal2.private@email.co"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItemFromTemplate("\\Domain\EmailTemplate\oft\test1.oft")

On Error Resume Next
With OutMail
    .BCC = myString + strCopy
    .Display
    '.Send
End With

On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

然后我重复了第二部分，将不同的列表/电子邮件模板指定为加载项中的单个宏。（。当我最终得到我想要的结果时，发送不会被注释掉。）

因此，当宏指定并将工作簿嵌入其自身时，这非常有效。所以有一段时间，我认为它一切正常，直到我使用了一个空白的工作簿，它仍然提取了我想要的数据，所以我检查并仔细检查了没有引用原始工作簿，然后我发现工作簿已构建到宏中。我尝试使用相同的代码重建加载项，它只是不起作用。

所以我的问题是，有没有办法构建这个宏，以便它可以在任何活动工作簿上工作？我想有一个简单的事情要点击或我忽略的其他东西。我正在使用Excel 2016。

Answer 1

首先，为什么你没有制作一个宏嵌入式模板，你有一个连接任何活动工作簿的表单。

dim ws as workbook

设置ws = activeworkbook

所以基本上制作一个模块化的表单，然后在标签点击事件中放置该代码。

然后执行按钮，以便在启动电子邮件发送自动化之前确定是否连接了正确的工作簿

Answer 2

我认为你可以根据自己的需要进行调整。

在Sheets（“Sheet1”）中创建一个列表：

In column A : Names of the people
In column B : E-mail addresses
In column C:Z : Filenames like this C:\Data\Book2.xls (don't have to be Excel files)

宏将遍历“Sheet1”中的每一行，如果B列中有电子邮件地址和C列中的文件名：Z它将创建一个包含此信息的邮件并发送。

Sub Send_Files()
'Working in Excel 2000-2016
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
    Dim OutApp As Object
    Dim OutMail As Object
    Dim sh As Worksheet
    Dim cell As Range
    Dim FileCell As Range
    Dim rng As Range

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set sh = Sheets("Sheet1")

    Set OutApp = CreateObject("Outlook.Application")

    For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)

        'Enter the path/file names in the C:Z column in each row
        Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")

        If cell.Value Like "?*@?*.?*" And _
           Application.WorksheetFunction.CountA(rng) > 0 Then
            Set OutMail = OutApp.CreateItem(0)

            With OutMail
                .to = cell.Value
                .Subject = "Testfile"
                .Body = "Hi " & cell.Offset(0, -1).Value

                For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
                    If Trim(FileCell) <> "" Then
                        If Dir(FileCell.Value) <> "" Then
                            .Attachments.Add FileCell.Value
                        End If
                    End If
                Next FileCell

                .Send  'Or use .Display
            End With

            Set OutMail = Nothing
        End If
    Next cell

    Set OutApp = Nothing
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

https://www.rondebruin.nl/win/s1/outlook/amail6.htm

Excel加载项/宏发送大量电子邮件

2 个答案: