How to extract email addresses from 1 worksheet to another workbook
On Tue, 22 Nov 2011 17:19:25 -0800 (PST), Mark wrote:
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.
Mark,
Here is some code that I use when I need to open a bunch of workbooks. I have modified it a bit for you and also made some comments.
For reasons not related to this project, most of the variables are declared as Public variables. What that means, if you choose to use it, is that you may need to avoid duplicate declarations in other code.
Note that the Pathname (string) must end with the "\"
Also note the spot where you can test the filename before opening the workbook, if that may be of any benefit.
Finally, you must set a reference to Microsoft Scripting Runtime. On the main menu of the VBE, select References and then look for Microsoft Scripting Runtime in the pull down.
====================================
'requires reference to Microsoft Scripting Runtime
Public wbk As Workbook
Public Path As String
Public wbPrefix As String
Public wbName As String
Public oFS As FileSystemObject, Fo As Folder, F As File
Option Explicit
Option Private Module
Public Sub OpenEmailSourceFiles()
'note the terminal "\" in Path definition
Path = "Your_Path" & "\"
Set oFS = New FileSystemObject
Set Fo = oFS.GetFolder(Path)
For Each F In Fo.Files
Debug.Print F.Name 'This line just for debugging
'If it returns the correct filenames, uncomment the
'next line, and delete the debug.print line
'you could also include some testing for file names if you
'don't need to open all the files in the folder
'Workbooks.Open (Path & F.Name)
Next F
Set oFS = Nothing
End Sub
'-------------------------------------------------------
Public Sub CloseEmailSourceFiles()
'clean up the mess by closing all those files
For Each wbk In Workbooks
If wb.Name < "The Name Of Your Results File" Then
wb.Close savechanges:=False
End If
Next wb
End Sub
|