Change the area between

For Each F * * *and * * Next F * * to:

If *Not F.Name *Like "~$*" then
* *Workbooks.Open(Path & F.Name)
end if


That worked perfectly. Cheers


You are probably using the first version of the ExtrEmails macro where I did not check to be sure an Admin worksheet was present, because that would give that error. *But wb was declared in the declarations area on both versions, so I don't know why you don't have that line there.

No I was using the 2nd version already. Poor wordchoice on my part
before. By declare I meant specify what exactly wb is. So we have
declared that wb is a Workbook but we haven't defined which workbooks
it should be searching to get the information.

So here is the exact code I have at the moment up until the error part
that gives subscript out of range.



Sub Admin()
Dim rSrc As Range, c As Range
Dim rDest As Range
Dim wb As Workbook, ws As Worksheet
Dim vRes() As Variant
Dim i As Long
Dim re As Object, mc As Object
Dim bFirstRun As Boolean
Const sPatEmail As String = "\b[A-Z0-9._%+-]+@(?:[A-Z0-9-]+\.)+[A-
Z]{2,6}\b"

OpenEmailSourceFiles

Set rDest = ThisWorkbook.Worksheets("Sheet2").Range("A1")
rDest.Worksheet.Cells.ClearContents

Set re = CreateObject("vbscript.regexp")
With re
.Pattern = sPatEmail
.Global = True
.ignorecase = True
End With

bFirstRun = True
For Each wb In Workbooks
If Not wb.Name = "C:\Users\xxxxx\admin details.xlsm" Then 'this is the
book that i want the email addresses pasted into
On Error Resume Next
Set ws = wb.Worksheets("Admin")
On Error GoTo 0
If Not ws Is Nothing Then
Set rSrc = wb.Worksheets("Admin").Range("A1:Z99")
================================================== ==================

I get the same error when I I have any range defined and also when I
use the simple .UsedRange