我创建的宏能够通过＆＃34; Reports（）＆＃34;循环很多次。在我收到消息弹出之前说＆＃34; Microsoft excel正在尝试恢复您的信息＆＃34;并且出现了我的vba脚本错误，表示＆＃34;运行时错误50290 - 应用程序定义或对象定义错误＆＃34;。此错误发生在：
Set rng = Nothing
Set rng = ActiveSheet.UsedRange '<<<<Here is where i get and error
我不确定为什么会发生这种情况，因为代码能够循环多次并发送几封电子邮件，然后每次都会随机停止并出现相同的错误。
我收到了错误：
With Application
.EnableEvents = False '<<<here
.ScreenUpdating = False '<<< when i commented "EnableEvents" out, i got it here
.DisplayAlerts = False
End With
但后来我把它评论出来并将它移到了下面的地方。设置rng = ActiveSheet.UsedRange＆＃39;开始
这是我的代码。我简化了它。
a = Array("saveFile/", "FL Tests", "FL", "test1@email.com")
Call Reports(a)
b = Array("saveFile/", "FL Tests", "FL", "test2@email.com")
Call Reports(b)
c = Array("saveFile/", "FL Tests", "FL", "test3@email.com")
Call Reports(c)
Function Reports(a As Variant)
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim olFldr As MAPIFolder
Dim olItms As Items
Dim olMi As MailItem
Dim olEmail As Outlook.MailItem
Dim olAtt As Attachment
Dim MyPath As String
Dim saveAs As String 'name for saving excel sheet in
Dim emails As String 'list of emails the sheet is going to
Dim departments As String 'string departments from array that need to be parsed
Dim states As String 'string states from array that need to be parsed
FilePath = "\" & a(0) & "\"
departments = a(1)
states = a(2)
emails = a(3)
today = Date
day = Format(today, "dd")
month = Format(today, "m")
year = Format(today, "yyyy")
d = Date - 1
saveAs = state & "_" & month & "_" & day & "_" & year
Set olApp = GetObject(, "Outlook.Application")
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(olFolderInbox)
Set olItms = olFldr.Items
Set olEmail = olApp.CreateItem(olMailItem)
'With Application <<<<<<< Was getting error here so i moved it below
'.EnableEvents = False
'.ScreenUpdating = False
'.DisplayAlerts = False
'End With
Set rng = Nothing
Set rng = ActiveSheet.UsedRange '<<<<<<<Here is where i get and error
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Application
.EnableEvents = False
.ScreenUpdating = False
.DisplayAlerts = False
End With
Set olMi = olItms.Find("[Subject] = " & Chr(34) & FL email & Chr(34))
If Not (olMi Is Nothing) Then
For Each olAtt In olMi.Attachments
olAtt.SaveAsFile MyPath & state & ".xls"
Set wB = Workbooks.Open("Folder/" & current_report & ".xls")
wB.Activate
Next olAtt
Else
End If
wB = ActiveWorkbook
wB.Save
With OutMail
.To = emails
.Subject = "Title"
.HTMLBody = Hello World!
.send
End With
On Error GoTo 0
ActiveWorkbook.Close
With Application
.EnableEvents = True
.ScreenUpdating = True
.DisplayAlerts = True
End With
On Error Resume Next
Set OutMail = Nothing
Set OutApp = Nothing
Set olAtt = Nothing
Set olMi = Nothing
Set olFldr = Nothing
Set olNs = Nothing
Set olApp = Nothing
End Function