Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
I'm at a real loss here. Excel loses focus!!!!!!
Hi All,
There are 2 code routines pasted below and both work fine individually. However if l call the 2nd routine from the 1st Excel seems to 'lose focus' ie the active workbook name is greyed out and flashing. If l actiavte Excel by placing and clicking the cursor anywhere in the Excel environment the code continues without a problem. I have tried combining the code but the same problem manifests itself. This is my 1st foray into extracting data from Outlook and l am wondering if it has something to do with security but that would not explain why the code continues immediately on return to the Excel environment. Please can somebody help me overcome this infuriating problem? Sub ListUnsubscribed() 'Variables for the Outlook Object Library Dim myOlApp As Outlook.Application Dim mpfInbox As Outlook.MAPIFolder Dim obj As Outlook.MailItem 'Other variables Dim i As Integer Dim r As Long Dim r1 As Long 'Define the variables Set myOlApp = CreateObject("Outlook.Application") Set mpfInbox = myOlApp.GetNamespace("MAPI").GetDefaultFolder(olFo lderInbox).Folders("Unsubscribers") 'Set calcualtion to manual for more speed Application.Calculation = xlManual 'Find next empty row on list Sheets("Removed").Activate Range("A2").Activate r = ActiveCell.End(xlDown).Row + 1 If r = 65536 Then MsgBox ("You have reached the limit of 65536 Unsubscribers") Exit Sub End If If r < 65536 Or r 1 Then r = r Else r = 2 End If 'Set 1st row for copy to TemporaryList r1 = r 'Loop all items in the Inbox\Unsubscribers Folder For i = 1 To mpfInbox.Items.Count If mpfInbox.Items(i).Class = olMail Then Set obj = mpfInbox.Items.Item(i) If obj.Subject = "unsubscribe" Or obj.Subject = " unsubscribe" Then With Sheets("Removed") .Cells(r, 1).Value = obj.SenderEmailAddress .Cells(r, 2).Value = obj.Subject .Cells(r, 3).Value = obj.ReceivedTime .Cells(r, 4).Value = Now .Cells.Columns.AutoFit End With 'Delete the email 'obj.Delete r = r + 1 End If End If Next 'Copy to TemporaryList Sheets("Removed").Range("A" & r1 & ":D" & r).Copy Destination:=Sheets("TemporaryList").Range("A2") End Sub Sub Delete_Unsubscribers() 'Delete unsubscribers from 'Current' sheet Dim delName As String Application.ScreenUpdating = True Sheets("TemporaryList").Activate Range("A2").Activate Do Until ActiveCell.Value = "" Sheets("TemporaryList").Activate delName = ActiveCell.Value Sheets("Current").Activate Range("A1").Activate With Sheets("Current").Range("A:A") Set c = .Find(delName, lookin:=xlValues, SearchOrder:=xlByColumns, SearchDirection:=xlNext) If c Is Nothing Then MsgBox "Search Value was not found" Else c.EntireRow.Delete End If End With Sheets("TemporaryList").Activate ActiveCell.Offset(1, 0).Activate Loop MsgBox ("finished") Sheets("TemporaryList").Activate Range("A2:D2").Select Range(Selection, Selection.End(xlDown)).Select Selection.ClearContents 'Reset to auto Application.Calculation = xlManual End Sub Regards Michael beckinsale |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
macro in chart loses focus | Charts and Charting in Excel | |||
Excel - Selected Cell highlight on focus loss. | Excel Discussion (Misc queries) | |||
Excel crashes when Combo Box loses focus | Excel Programming | |||
excel focus problems with custom RTD server (real time data) | Excel Programming | |||
UserForm Loss Focus | Excel Programming |