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 wouldgive 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
