Outlook VBA：ブックのアクティブ化、行のアクティブ化、コピーされた行の挿入

Question

電子メールの受信トレイの検索に基づいて添付ファイルを保存する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 

Answer 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