2017-04-11 136 views
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 

回答

0
If TypeName(myitem) = "MailItem" And Not (myitem.Sender Is Nothing) Then 

你需要把這兩項測試不同如果塊

If TypeName(myitem) = "MailItem" Then 
    If Not (myitem.Sender Is Nothing) Then 

    End If 
End if 

你需要做這種方式的原因是,在VBA中And不「短路」 - 即使該項目不是郵件項目(所以測試的第一部分是False),tes的第二部分t仍然運行,因此該項目可能沒有Sender屬性,這會導致您看到的錯誤。

+0

您好,如何關閉(無法刪除)現有的excel表單全力。因爲當excel文件從下次運行時的代碼中刪除時,它會將該錯誤視爲權限被拒絕(打開文件)。我正在做什麼(曇花一現的解決方案)會進入任務管理器並找到特定的進程並將其殺死 –

+0

您應該爲此打開一個新問題。 –

+0

謝謝蒂姆。非常感謝 –

相關問題