Question

我有一些VBA代码可以直接通过Outlook电子邮件发送Excel工作表。我将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

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

Answer 1

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

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

要插入Visual Basic模块，请执行以下操作： -在Visual Basic编辑器的Project Explorer中，激活包含相关代码的工作簿。 -在“插入”菜单上，单击“模块”。 -插入新模块后，从其原始位置剪切代码并将其粘贴到Visual Basic模块中。然后，保存工作簿。

有关更多信息，请参见VBA code "behind" a worksheet or a workbook may not work in Excel。

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

P.S。如果您需要将基于Office的解决方案分发到多台计算机，建议您开发基于VSTO的加载项。在Walkthrough: Create your first VSTO Add-in for Excel文章中详细了解它们。

通过vba发送电子邮件，但未发送具有功能的模块

1 个答案: