Sub或Function未定义MS Access SendEmailFromOutlook

时间:2018-05-18 16:58:47

标签: vba ms-access

嘿,我相信这将是一个非常快速的解决方案,当有人向我指出时,我会认真地认为我没有看到它!但我一直试图让这个函数被称为" SendEmailWithOutlook"从另一个子,它只是不工作。

If Not (CountriesFilter.EOF And CountriesFilter.BOF) Then
    CountriesFilter.MoveFirst
    Do Until CountriesFilter.EOF = True
        If Not (EmailCountry.EOF And EmailCountry.BOF) Then
            EmailCountry.MoveFirst
            Do Until EmailCountry.EOF = True
                If EmailCountry!Country = CountriesFilter!Country Then
                    Country = CountriesFilter!Country
                    Email = EmailCountry!EmailEmail

                    DoCmd.DeleteObject acTable, "BadUsers"
                    Set qdfsCountry = CurrentDb.QueryDefs("BadUsersqry")
                    qdfsCountry!WhatCountry = Country
                    qdfsCountry.Execute
                    Set qdfsCountry = Nothing

                    DoCmd.DeleteObject acTable, "OkayUsers"
                    Set qdfsCountry = CurrentDb.QueryDefs("OkayUsersqry")
                    qdfsCountry!WhatCountry = Country
                    qdfsCountry.Execute
                    Set qdfsCountry = Nothing

                    DoCmd.DeleteObject acTable, "GoodUsers"
                    Set qdfsCountry = CurrentDb.QueryDefs("GoodUsersqry")
                    qdfsCountry!WhatCountry = Country
                    qdfsCountry.Execute
                    Set qdfsCountry = Nothing

                    DoCmd.TransferSpreadsheet acExport, 10, 
"BadUsers", "L:\WeeklyUserActivity\WeeklyUserBreakDown" & Country & ".xlsx", 
True, "BadUsers"
                    DoCmd.TransferSpreadsheet acExport, 10, 
"OkayUsers", "L:\WeeklyUserActivity\WeeklyUserBreakDown" & Country & 
".xlsx", True, "OkayUsers"
                    DoCmd.TransferSpreadsheet acExport, 10, 
"GoodUsers", "L:\WeeklyUserActivity\WeeklyUserBreakDown" & Country & 
".xlsx", True, "GoodUsers"

                    Main 
"L:\WeeklyUserActivity\WeeklyUserBreakDown" & Country & ".xlsx"
                    ***Call SendEmailWithOutlook***
                End If
                Email = ""
                EmailCountry.MoveNext
            Loop
        End If
        Country = ""
        CountriesFilter.MoveNext
    Loop
End If

这是它正在调用的函数

Public Function SendEmailWithOutlook()
Dim sentfrom As String
Dim toemail As String
Dim subjectemail As String

sentfrom = "An EMAIL"
  ' Define app variable and get Outlook using the "New" keyword
  Dim olApp As New Outlook.Application
  Dim MItem As Outlook.MailItem ' An Outlook Mail item
  'Dim myattachments As Outlook.Attachments

  ' Create a new email object
  Set MItem = olApp.CreateItem(olMailItem)
  'Set myattachments = MItem.Attachments
  ' Add the To/Subject/Body to the message and display the message
  With MItem
    .To = Email
    .Subject = "WeeklyUserBreakDown"
    .Body = "Automated Email. Please Find your weekly user Breakdown 
  Spreadsheet attachted"
    .Attachments.Add ("L:\WeeklyUserActivity\WeeklyUserBreakDown" & Country 
  & ".xlsx")
    .Send       ' Send the message immediately
  End With
  Exit Function
  email_error:
  MsgBox "An Error was encountered. " & vbCrLf & "The error message is: " & 
  Err.Description
  Resume Error_out
  Error_out:
  ' Release all object variables
  Set MItem = Nothing
  Set olApp = Nothing
  End Function

该功能是一个模块,所以应该可以调用它。但仍然不知道为什么我无法称呼它。

1 个答案:

答案 0 :(得分:1)

我想我已经设法解决了这个问题,我把这个功能移到了模块文件夹(在类模块文件夹之外),程序现在可以编译并运行了感谢所有花时间和精力帮助我的人。