Outlook VBA：激活工作簿、激活行、插入复制的行答案

【问题标题】：Outlook VBA: Activating a Workbook, Activating a Row, Inserting Copied RowsOutlook VBA：激活工作簿、激活行、插入复制的行
【发布时间】：2016-07-28 23:12:27
【问题描述】：

我有一个 Outlook 宏，它可以根据对电子邮件收件箱的搜索来保存附件。然后打开聚合文件，然后循环打开第一个保存的附件并复制“AggregateThis”命名范围。我需要实现的是： 1）。激活聚合文件 2）。激活“END”搜索结果所在的行 3）。将复制的单元格插入到末尾

Outlook 对象模型给我带来了麻烦，这在 Excel VBA 中简直是小菜一碟。您的帮助意义重大！

 Dim xlApp As Object
 Set xlApp = CreateObject("Excel.Application")
 With xlApp
.Visible = True
.EnableEvents = False
.DisplayAlerts = False
.ScreenUpdating = False
.Workbooks.Open ("J:\Retail Finance\Varicent\General Teamshare Resources\Acting Mgr Assignment Bonus Aggregation.xlsx")

Dim x As Variant
i = -1
For Each x In AttachNames
Dim wb As Object
i = i + 1
Set wb = .Workbooks.Open("J:\Retail Finance\Varicent\General Teamshare Resources\Teamshare AAA\" & AttachNames(i))
Set wb = .Worksheets("Additional Assignment Bonus FRM")
            'Copies the "Aggregate This" named range from the Individual File (i)
With wb.Range("AggregateThis")
    .Copy
End With
            'Switches focus to Aggregation File
Set wb = .Workbooks("J:\Retail Finance\Varicent\General Teamshare Resources\Acting Mgr Assignment Bonus Aggregation.xlsx")
With wb
    .Activate                           '#1). I want to put focus on this file it throws an error
End With

'Find EndRow in the Aggregation File
Set wb = .Worksheets("Additional Assignment Bonus FRM").Cells.Find("End")
With wb
         .ActivateRow                  '#2).This throws an error
         .PasteSpecialInsertRows       '#3). This doesnt work
End With
Next

【问题讨论】：

我没有看到你为 excel 声明应用程序对象。
我将包含那部分代码，谢谢！
要使用.Activate，您需要打开屏幕更新。
这就是阻碍我整个项目的原因！那爆破的屏幕更新。我将发布我的问题的答案，指出关闭屏幕更新的副作用。那么你就是男人@Sorceri！
@Sorceri ，你能帮我解决粘贴命令的语法吗：这是我提交的答案中倒数第 5 行。否则，其他一切正常。

标签： excel vba outlook

【解决方案1】：

原始代码无法正常工作，因为要使 .Activate 工作，必须将 ScreenUpdating 设置为 True（默认情况下）。

Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
With xlApp
.Visible = True
.EnableEvents = False
.DisplayAlerts = False
.ScreenUpdating = True    '## Was set to False in code originally##
.Workbooks.Open ("J:\Retail Finance\Varicent\General Teamshare Resources\Acting Mgr Assignment Bonus Aggregation.xlsx")
Dim x As Variant
i = -1
For Each x In AttachNames
Dim wb As Object
i = i + 1
Set wb = .Workbooks.Open("J:\Retail Finance\Varicent\General Teamshare Resources\Teamshare AAA\" & AttachNames(i))
With xlApp
   .Worksheets("Additional Assignment Bonus FRM").Range("AggregateThis").Copy     'Copies Range
End With
Set wb = .Workbooks.Open("J:\Retail Finance\Varicent\General Teamshare Resources\Acting Mgr Assignment Bonus Aggregation.xlsx")
With wb
    .Worksheets("Additional Assignment Bonus FRM").Rows.Find("End").Select
    .Worksheets("Additional Assignment Bonus FRM").Activerange.Paste  '##This needs to be fixed##, will edit response soon.
End With
Next
End With
End Sub

【讨论】：