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文件從下次運行時的代碼中刪除時,它會將該錯誤視爲權限被拒絕(打開文件)。我正在做什麼(曇花一現的解決方案)會進入任務管理器並找到特定的進程並將其殺死 –
您應該爲此打開一個新問題。 –
謝謝蒂姆。非常感謝 –