通过vba发送邮件但没有发送功能模块

Posted 2023-02-24

【中文标题】通过vba发送邮件但没有发送功能模块

【英文标题】：Sending emails through vba but the modules with functions were not sent

【发布时间】：2019-07-11 10:02:07

【问题描述】：

我有一些直接通过 Outlook 电子邮件发送 excel 表的 vba 代码。我将 excel 文件保存为 .xlsm，因此宏和 VBA 程序可以在我的设备上运行。但是，当电子邮件的收件人打开 Excel 表时，不会发送模块（包含某些用户定义的公式）。我想知道是否有一种方法可以确保模块是通过电子邮件发送的，或者我可以在其他地方放置函数的代码，以便自动通过电子邮件发送。

提前感谢您的帮助。

我已经尝试在网上寻找任何情况，但我看到的只是将函数放入模块中，并且没有关于如何使用通过 vba 创建的电子邮件发送模块的说明。

电子邮件：

Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object

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

Set Sourcewb = ActiveWorkbook

'Copy the ActiveSheet to a new workbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook

'Determine the Excel version and file extension/format
With Destwb
    If Val(Application.Version) < 12 Then
        'You use Excel 97-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'You use Excel 2007-2016
        Select Case Sourcewb.FileFormat
        Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
        Case 52:
            If .HasVBProject Then
                FileExtStr = ".xlsm": FileFormatNum = 52
            Else
                FileExtStr = ".xlsx": FileFormatNum = 51
            End If
        Case 56: FileExtStr = ".xls": FileFormatNum = 56
        Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
        End Select
    End If
End With

'    'Change all cells in the worksheet to values if you want
'    With Destwb.Sheets(1).UsedRange
'        .Cells.Copy
'        .Cells.PasteSpecial xlPasteValues
'        .Cells(1).Select
'    End With
'    Application.CutCopyMode = False

'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = "Part of " & Sourcewb.name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With Destwb
    .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
    On Error Resume Next
    With OutMail
        .to = Range("B61")
        .CC = ""
        .BCC = ""
        .Subject = "CS Equipment Pricebook"
        .Body = Range("B30:B40")
        .Attachments.Add Destwb.FullName
        'You can add other files also like this
        '.Attachments.Add ("C:\test.txt")
        .Send   'or use .Display
    End With
    On Error GoTo 0
    .Close savechanges:=False
End With

'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With

功能：

Function username()
    username = Environ("Username")
End Function

无论何时发送邮件，具有该功能的模块都不会发送。

【参考方案1】：

为了使自动运行的子例程在 Microsoft Excel 中正常工作，它们必须包含在 Visual Basic 模块中。

您必须在工作簿中插入一个 Visual Basic 模块，然后将代码放入新模块中。

要插入 Visual Basic 模块： - 在 Visual Basic 编辑器的项目资源管理器中，激活包含相关代码的工作簿。 - 在插入菜单上，单击模块。 - 插入新模块后，从其原始位置剪切代码并将其粘贴到 Visual Basic 模块中。然后，保存工作簿。

请参阅VBA code "behind" a worksheet or a workbook may not work in Excel 了解更多信息。

最后，确保所有内容都包含在您的工作簿中，请参阅Where is the Excel Personal Macro Workbook Located?。

附：如果您需要将基于 Office 的解决方案分发到多台计算机，我建议您开发基于 VSTO 的加载项。在Walkthrough: Create your first VSTO Add-in for Excel 文章中阅读更多关于它们的信息。

【讨论】：

感谢您的回复。当我打开文件时，这些模块将在我的计算机上运行；但是，当我将文件作为带有 vba 代码的电子邮件附件发送时，该模块不会包含在附件中。我在网上查看，他们说需要为每台想要访问 Excel 工作簿的计算机下载一个单独的加载项。我想知道是否有一种方法可以在不使用附加插件的情况下将模块与工作簿一起发送