Question

我还是VBA的新手，但是尝试自动执行某些功能时遇到了问题。即，我似乎无法立即运行它（Ctrl + G），并且当我尝试在宏中调用它时，出现无法找到命名函数的错误。

当我运行不带任何变量的代码（例如emailPaste（））时，它可以工作，并且此代码取自以下位置：http://www.rondebruin.nl/win/s1/outlook/bmail2.htm

我尝试将其保留为emailPaste（），然后在立即/宏RunCode中调用该函数，但仍然存在相同的问题。

我已将模块命名为：EmailWithPaste

当前代码：

Option Compare Database

Sub emailPaste(exFile As String, exSheet As String, EmailSubject As String, _
To_Field As String, Optional CC_Field As String)

Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim ApXL As Object

Set ApXL = CreateObject("Excel.Application")
ApXL.Workbooks.Open (exFile)


Set rng = Nothing
' Only send the visible cells in the selection.

Set rng = Sheets(exSheet).Range("A1:D12").SpecialCells(xlCellTypeVisible)

'If rng Is Nothing Then
    'MsgBox "The selection is not a range or the sheet is protected. " & _
       vbNewLine & "Please correct and try again.", vbOKOnly
    'Exit Sub
'End If

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

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


With OutMail
    .To = To_Field
    .CC = CC_Field
    .Subject = EmailSubject
    .HTMLBody = RangetoHTML(rng)
    ' In place of the following statement, you can use ".Display" to
    ' display the e-mail message.
    .Display
End With
On Error GoTo 0

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

Set OutMail = Nothing
Set OutApp = Nothing
End Sub


Function RangetoHTML(rng As Range)
' By Ron de Bruin.
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        TempWB.Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         FileName:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                      "align=left x:publishsource=")

    'Close TempWB
    TempWB.Close savechanges:=False

    'Delete the htm file we used in this function
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

Answer 1

Subs可以不带括号或不推荐使用Call关键字来调用。只有带括号的函数才能调用，因此 Expected函数或变量。

此外，RunCode运行函数，而不是子程序。

一个简单的解决方法是将代码更改为函数，即使它什么也不返回：

Public Function emailPaste(exFile As String, exSheet As String, EmailSubject As String, _
To_Field As String, Optional CC_Field As String)
      'The code
End Function

而且，由于它什么也不返回，因此仍应在立即窗口中将其称为子项：

emailPaste "C:\Users\KF\Desktop\TestExcelExport.xlsx","Sheet2","Test","test","cc"

MS Access 2016找不到我的功能/模块

1 个答案: