1
新的VBA宏。我有一个VBA宏(我在这些宏中修改了很多)它将在给定的特定时间范围内获得邮件详细信息(Subject,Sender,Occurrence)。在收到最近30分钟的邮件时,宏工作正常。但是当增加时间范围像1小时30分钟时,我得到对象的错误不支持此属性或方法438.请你帮忙。以下是脚本。我正在错误的下面一行'如果类型名(myitem)=‘的MailItem’,而不是(myitem.Sender是没有什么)然后对象不支持此属性或方法438在vba展望
'Declare variables needed
Dim i As Long, k As Long: i = 2
k = 1
'Get Mailbox Name from User for naming Excel Workbook
Dim excelName As Variant
Dim mydaet1 As Date, mydate As Date
Dim iFolder As Long
Dim olFldr As Outlook.MAPIFolder
mydate1 = Now
mydate = Now + TimeSerial(0, -90, 0)
excelName = "Example_Mail_Count"
'Delete the excel file if already exists
If Dir("C:\Temp\" + excelName + ".xlsx") <> "" Then
MsgBox "A file with name " + excelName + ".xlsx already exists in C:\Temp\ Folder. Take backup, if needed. It will be deleted now."
Kill "C:\Temp\" + excelName + ".xlsx"
MsgBox "Excel File Deleted!"
End If
'Create instance for Excel
Set objXl = CreateObject("Excel.Application")
With objXl
.Visible = False
.EnableEvents = True
End With
'Create instance for Outlook
Set objOutlook = CreateObject("Outlook.Application")
Set objnSpace = objOutlook.GetNamespace("MAPI")
iFolder = 1
'Create a new Excel Workbook
Set xlworkbook = objXl.Workbooks.Add
With xlworkbook
.SaveAs FileName:="C:\Temp\" + excelName + ".xlsx"
End With
xlworkbook.Worksheets("Sheet1").Activate
'Header for the report
xlworkbook.ActiveSheet.Range("A" & i) = "Subject"
xlworkbook.ActiveSheet.Range("B" & i) = "Sender"
xlworkbook.ActiveSheet.Range("C" & i) = "Occurrences"
'Add other fields here as needed
xlworkbook.ActiveSheet.Rows(i).Font.Bold = True
Do While True
Select Case iFolder
Case 1: Set olFldr = objnSpace.Folders("First_Mail_Box").Folders("Inbox")
xlworkbook.ActiveSheet.Range("A" & k) = "First"
xlworkbook.ActiveSheet.Rows(k).Font.Bold = True
Case 2: Set olFldr = objnSpace.Folders("Sec_Mail_box").Folders("Inbox")
i = i + 1
xlworkbook.ActiveSheet.Range("A" & i) = "Second"
xlworkbook.ActiveSheet.Rows(i).Font.Bold = True
Case Else: Exit Do
End Select
'Display dialog box to select outlook folder
Set myItemsTemp = olFldr.Items
'Filter emails and Sort by Subject
'****!!!!Update the date interval as needed****!!!!
Set myItems = myItemsTemp.Restrict("[ReceivedTime] >='" & Format(mydate, "ddddd hh:nn AMPM") & "' AND [ReceivedTime] <= '" & Format(mydate1, "ddddd hh:nn AMPM") & "' ")
myItems.Sort "[Subject]"
'Loop through each email item in the folder selected
For Each myitem In myItems
If TypeName(myitem) = "MailItem" And Not (myitem.Sender Is Nothing) Then
i = i + 1
xlworkbook.ActiveSheet.Range("A" & i) = myitem.Subject
xlworkbook.ActiveSheet.Range("B" & i) = myitem.Sender
k = i
Else
i = i + 1
xlworkbook.ActiveSheet.Range("A" & i) = myitem.Subject
xlworkbook.ActiveSheet.Range("B" & i) = myitem.SenderName
k = i
End If
Next myitem
'Count instances and remove duplicates
xlworkbook.ActiveSheet.Range("C3:C" & i).FormulaR1C1 = "=COUNTIFS(C[-2],RC[-2],C[-1],RC[-1])"
xlworkbook.ActiveSheet.Range("C3:C" & i).Value = xlworkbook.ActiveSheet.Range("C3:C" & i).Value
xlworkbook.ActiveSheet.Range("$A$3:$C$" & i).RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
xlworkbook.ActiveSheet.Columns("A").ColumnWidth = 50
xlworkbook.ActiveSheet.Columns("B").ColumnWidth = 35
xlworkbook.ActiveSheet.Columns("C").ColumnWidth = 20
iFolder = iFolder + 1
Loop
'Save and close the workbook
xlworkbook.Save
MsgBox "*************************************Done*************************************" + vbCrLf + vbCrLf + "Generated Report " + excelName + ".xlsx file in C:\Temp\ Folder. Take Backup or Leave it"
'xlworkbook.Close
xlworkbook.Activate
objXl.Visible = True
'Exit Excel Application
'Deallocate all instances
Set myItemsTemp = Nothing
Set myItems = Nothing
Set objFolder = Nothing
Set NS = Nothing
Set objnSpace = Nothing
Set objOutlook = Nothing
Set objXl = Nothing
'Finish it up
' MsgBox "*************************************Done*************************************" + vbCrLf + vbCrLf + "Please view " + excelName + ".xlsx file in C:\Temp\ Folder for the report."
'Shell "C:\Windows\explorer.exe C:\Temp\", vbNormalFocus
您好,如何关闭(无法删除)现有的excel表单全力。因为当excel文件从下次运行时的代码中删除时,它会将该错误视为权限被拒绝(打开文件)。我正在做什么(昙花一现的解决方案)会进入任务管理器并找到特定的进程并将其杀死 –
您应该为此打开一个新问题。 –
谢谢蒂姆。非常感谢 –