How to extract email addresses from 1 worksheet to another workbook

  • Thread starter Thread starter Mark
  • Start date Start date
M

Mark

Hi,

I'm trying to get all the email addresses from a worksheet called
"Admin" across to a separate workbook.

I am able to copy and paste from a specific cell but certain workbooks
have the email address in different cells so I need something that
gets all the email addresses in a particular sheet and spits it out to
the new workbook.

I keep getting no addresses at all while attempting to do this
currently.

Thanks,
Mark.
 
Details Mark, we need details...

How many email addresses on a single sheet... one, many?

Will the email address(es) be found in a single column or, if more than one,
are they scattered all about on the sheet?

If in a single column, is that column the same for each worksheet?


Rick Rothstein (MVP - Excel)
 
Details Mark, we need details...

How many email addresses on a single sheet... one, many?

Will the email address(es) be found in a single column or, if more than one,
are they scattered all about on the sheet?

If in a single column, is that column the same for each worksheet?

Rick Rothstein (MVP - Excel)
Click to expand...

As Rick says, details, but you may eventually use a macro using
FINDNEXT to look for partial hits on "@" and moving that cell or row
or? from _____ to where_____________
 
Details Mark, we need details...

How many email addresses on a single sheet... one, many?

Will the email address(es) be found in a single column or, if more than one,
are they scattered all about on the sheet?

If in a single column, is that column the same for each worksheet?

Rick Rothstein (MVP - Excel)
Click to expand...

Yeah sorry guys found it hard to be specific without including loads
of useless rubbish too :)

But to answer questions.

Sometimes the Admin sheet will have 1 email address but other times it
will have many.
These will generally be in columns D-F (unfortunately i don't have
control of those sheets otherwise they'd all be in the exact same
cell)

Will try out Ron's script and let you guys know how i go.

Thanks for the advice.
 
Oh 1 more thing I forgot is that it will be opening multiple workbooks
in a specific folder e.g ("mark\documents\data")
 
Tried Ron's and it works to a degree. If I have the specified file
open already it will extract all emails perfectly.

However as I mentioned above it will need to open multiple workbooks
from a folder. I currently have the following extra code in addition
to Rons but it is not opening any workbooks.

Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String
FNum As Long


MyPath = "\\NBN2k8003\Data\NSOC - Docklands\Access Seekers\Access
Seeker Contact Matrices.Fibre"
 
Tried Ron's and it works to a degree. If I have the specified file
open already it will extract all emails perfectly.

However as I mentioned above it will need to open multiple workbooks
from a folder. I currently have the following extra code in addition
to Rons but it is not opening any workbooks.


Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String
Dim FNum As Long

MyPath = "\\mypath"

FNum = 0
Do While FilesInPath <> ""
FNum = FNum + 1
ReDim Preserve MyFiles(1 To FNum)
MyFiles(FNum) = FilesInPath
FilesInPath = Dir()
Loop


If FNum > 0 Then
For FNum = LBound(MyFiles) To UBound(MyFiles)
Set wb = Nothing
On Error Resume Next
Set wb = Workbooks.Open(MyPath & MyFiles(FNum))
On Error GoTo 0


However no workbooks try to open.

This is a work project btw and I'll be off from now for the next 48
hours so most likely wont look here again until then.

Thanks again for the help.
 
If you try my script, try it first after you manually open all of the documents -- we can include that once we get the basics ironed out.
Click to expand...


OK that worked perfectly with it open (I wrote this earlier but it
hasn't appeared so sorry if this doubles up later)

In addition to your code I have

Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String
Dim FNum as Long

MyPath = "mypath"

FNum = 0
Do While FilesInPath <> ""
FNum = FNum + 1
ReDim Preserve MyFiles(1 To FNum)
MyFiles(FNum) = FilesInPath
FilesInPath = Dir()
Loop

If FNum > 0 Then
For FNum = LBound(MyFiles) To UBound(MyFiles)
Set wb = Nothing
On Error Resume Next
Set wb = Workbooks.Open(MyPath & MyFiles(FNum))
On Error GoTo 0
=====================================

however it is not opening any books.

Thanks again for all your help with this.

Ps. this is a work project and I won't be back here for another 48
hours so there may be a delay in my next response.
'
 
I forgot to write that, after you get this working, you would use this code by inserting calls to these macros within the basic routine.

You could put a line:

OpenEmailSourceFiles   just after the initial declarations in the Extract email macro

and put:

CloseEmailSourceFiles

just before the Exit Sub in that macro.
Click to expand...

OK thanks for that Ron, it looks like it will work properly but I have
2 small problems still.

1) Unfortunately the folder I am scraping from is not mine so it has
the occassional rubbish leftover file that starts with ~$ that office
leaves behind. The macro errors when trying to open that. This is
minor and I can get around it by copying and pasting to another
folder.

2) I am getting a subscript out of range error (run time error 9) with
the following line highlighted

Set rSrc = wb.Worksheets("Admin").UsedRange

I believe it might be because the the code says

For Each wb In Workbooks

yet wb is not defined anywhere. Would that be correct? I've tried a
few different things but they all fail and bring up a new error :)

Thanks.
 
Change the area between
For Each F      and     Next F     to:

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


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.
Click to expand...

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
 
Oh for crying out loud!!!!! I worked it out. I opened all 32
spreadsheets and found 1 of them had a sheet named "Administration"
instead of "Admin"

Tested again and code worked flawlessly!

Thankyou so much for your time and patience Ron!!!!
 
The workbook that wb gets assigned to is via the :

For Each wb In Workbooks

statement.

Then we except the wb that you have the results going into, and we shouldalso be skipping any wb's that don't have an "Admin" worksheet.  So I don't understand your error you mentioned in your next post, unless possibly that workbook had an Admin worksheet, but had its data on the Administration worksheet.
Click to expand...

Thanks for that explanation, makes sense now.

I can see the code there that should be skipping over wb's without an
"Admin" sheet but it definitely errors when it has a different name
(also no "Admin" sheet on the one with the incorrect name).

In a perfect World I'd have the code skipping over those books but I'm
ok to do the better housekeeping to keep all wb's consistent.

Thanks Again
 
Back
Top