2017-04-11 95 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

谢谢蒂姆。非常感谢 –

相关问题