ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   vba to send multiple workbooks to different address (https://www.excelbanter.com/excel-discussion-misc-queries/253623-vba-send-multiple-workbooks-different-address.html)

jamesc

vba to send multiple workbooks to different address
 
hi everyone,

I have 80 workbooks in one folder. i'd like to be able to find a way to
automate opening each workbook, finding an email address in a1 and create
and send an email. i'd like for this to cycle through every workbook in the
folder. any ideas?

Thanks in advance!

James



JLGWhiz[_2_]

vba to send multiple workbooks to different address
 
Check out Ron's site. He has several tips on sending email.

http://www.rondebruin.nl/sendmail.htm



"jamesc" wrote in message
...
hi everyone,

I have 80 workbooks in one folder. i'd like to be able to find a way to
automate opening each workbook, finding an email address in a1 and create
and send an email. i'd like for this to cycle through every workbook in
the folder. any ideas?

Thanks in advance!

James




jamesc

vba to send multiple workbooks to different address
 
Hi JLGWhiz!
Thanks for your response, i actually started on that page, but didn't find
anything there that fits what i'm trying to do exactly. I have 80 unopened
workbooks in the folder, what i was hoping to do was find a way to
automatically open each wb, find an email address, then create an email
attaching that wb and sending it.

unless, it's there and i am missing it.

James



"JLGWhiz" wrote in message
news:OlJvuuxlKHA.5656@TK2MSFsing something.

TNGP02.phx.gbl...
Check out Ron's site. He has several tips on sending email.

http://www.rondebruin.nl/sendmail.htm



"jamesc" wrote in message
...
hi everyone,

I have 80 workbooks in one folder. i'd like to be able to find a way to
automate opening each workbook, finding an email address in a1 and create
and send an email. i'd like for this to cycle through every workbook in
the folder. any ideas?

Thanks in advance!

James






Ron de Bruin

vba to send multiple workbooks to different address
 
Hi James

Do you use Outlook or OE or Windows Mail

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"jamesc" wrote in message ...
hi everyone,

I have 80 workbooks in one folder. i'd like to be able to find a way to
automate opening each workbook, finding an email address in a1 and create
and send an email. i'd like for this to cycle through every workbook in the
folder. any ideas?

Thanks in advance!

James



jamesc

vba to send multiple workbooks to different address
 
hi Ron!

Thank you for your response, as well as your website and tips, I've learned
so much from you!

I use Outlook 2003 for XP.

James


"Ron de Bruin" wrote in message
...
Hi James
Do you use Outlook or OE or Windows Mail

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"jamesc" wrote in message
...
hi everyone,

I have 80 workbooks in one folder. i'd like to be able to find a way to
automate opening each workbook, finding an email address in a1 and create
and send an email. i'd like for this to cycle through every workbook in
the folder. any ideas?

Thanks in advance!

James




Ron de Bruin

vba to send multiple workbooks to different address
 
Hi test this one
It will check cell a1of the first sheet of each workbook

Change this to your test folder with a few test files

MyPath = "C:\Users\Ron Desktop\test"

Change this to .Send if it is OK
.Display 'or use .Send




Sub Example()
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String, Fnum As Long
Dim mybook As Workbook
Dim CalcMode As Long
Dim sh As Worksheet
Dim ErrorYes As Boolean
Dim OutApp As Object
Dim OutMail As Object

'Fill in the path\folder where the files are
MyPath = "C:\Users\Ron Desktop\test"

'Add a slash at the end if the user forget it
If Right(MyPath, 1) < "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xl*")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath < ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop

'Change ScreenUpdating, Calculation and EnableEvents
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

Set OutApp = CreateObject("Outlook.Application")

'Loop through all files in the array(myFiles)
If Fnum 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
On Error GoTo 0

If Not mybook Is Nothing Then
If mybook.Worksheets(1).Range("A1").Value < "" Then

Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = mybook.Worksheets(1).Range("A1").Value
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add mybook.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Display 'or use .Send
End With

If Err.Number 0 Then
ErrorYes = True
Err.Clear
On Error GoTo 0
End If

Else
ErrorYes = True
End If

'Save and close mybook
mybook.Close savechanges:=False
Else
'Not possible to open the workbook
ErrorYes = True
End If

Next Fnum
End If

If ErrorYes = True Then
MsgBox "There are problems in one or more files, possible problem:" _
& vbNewLine & "???????????????"
End If

Set OutApp = Nothing

'Restore ScreenUpdating, Calculation and EnableEvents
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"jamesc" wrote in message ...
hi Ron!

Thank you for your response, as well as your website and tips, I've learned
so much from you!

I use Outlook 2003 for XP.

James


"Ron de Bruin" wrote in message
...
Hi James
Do you use Outlook or OE or Windows Mail

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"jamesc" wrote in message
...
hi everyone,

I have 80 workbooks in one folder. i'd like to be able to find a way to
automate opening each workbook, finding an email address in a1 and create
and send an email. i'd like for this to cycle through every workbook in
the folder. any ideas?

Thanks in advance!

James




Ron de Bruin

vba to send multiple workbooks to different address
 
'Save and close mybook
mybook.Close savechanges:=False

Must be

'Not Save and close mybook


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Ron de Bruin" wrote in message ...
Hi test this one
It will check cell a1of the first sheet of each workbook

Change this to your test folder with a few test files

MyPath = "C:\Users\Ron Desktop\test"

Change this to .Send if it is OK
.Display 'or use .Send




Sub Example()
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String, Fnum As Long
Dim mybook As Workbook
Dim CalcMode As Long
Dim sh As Worksheet
Dim ErrorYes As Boolean
Dim OutApp As Object
Dim OutMail As Object

'Fill in the path\folder where the files are
MyPath = "C:\Users\Ron Desktop\test"

'Add a slash at the end if the user forget it
If Right(MyPath, 1) < "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xl*")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath < ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop

'Change ScreenUpdating, Calculation and EnableEvents
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

Set OutApp = CreateObject("Outlook.Application")

'Loop through all files in the array(myFiles)
If Fnum 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
On Error GoTo 0

If Not mybook Is Nothing Then
If mybook.Worksheets(1).Range("A1").Value < "" Then

Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = mybook.Worksheets(1).Range("A1").Value
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add mybook.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Display 'or use .Send
End With

If Err.Number 0 Then
ErrorYes = True
Err.Clear
On Error GoTo 0
End If

Else
ErrorYes = True
End If

'Save and close mybook
mybook.Close savechanges:=False
Else
'Not possible to open the workbook
ErrorYes = True
End If

Next Fnum
End If

If ErrorYes = True Then
MsgBox "There are problems in one or more files, possible problem:" _
& vbNewLine & "???????????????"
End If

Set OutApp = Nothing

'Restore ScreenUpdating, Calculation and EnableEvents
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"jamesc" wrote in message ...
hi Ron!

Thank you for your response, as well as your website and tips, I've learned
so much from you!

I use Outlook 2003 for XP.

James


"Ron de Bruin" wrote in message
...
Hi James
Do you use Outlook or OE or Windows Mail

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"jamesc" wrote in message
...
hi everyone,

I have 80 workbooks in one folder. i'd like to be able to find a way to
automate opening each workbook, finding an email address in a1 and create
and send an email. i'd like for this to cycle through every workbook in
the folder. any ideas?

Thanks in advance!

James




jamesc

vba to send multiple workbooks to different address
 
Ron, this is perfect!!!
this absolutely does what i need! thanks so much!

James


"Ron de Bruin" wrote in message
...
'Save and close mybook
mybook.Close savechanges:=False

Must be

'Not Save and close mybook


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Ron de Bruin" wrote in message
...
Hi test this one
It will check cell a1of the first sheet of each workbook

Change this to your test folder with a few test files

MyPath = "C:\Users\Ron Desktop\test"

Change this to .Send if it is OK
.Display 'or use .Send




Sub Example()
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String, Fnum As Long
Dim mybook As Workbook
Dim CalcMode As Long
Dim sh As Worksheet
Dim ErrorYes As Boolean
Dim OutApp As Object
Dim OutMail As Object

'Fill in the path\folder where the files are
MyPath = "C:\Users\Ron Desktop\test"

'Add a slash at the end if the user forget it
If Right(MyPath, 1) < "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xl*")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath < ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop

'Change ScreenUpdating, Calculation and EnableEvents
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

Set OutApp = CreateObject("Outlook.Application")

'Loop through all files in the array(myFiles)
If Fnum 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
On Error GoTo 0

If Not mybook Is Nothing Then
If mybook.Worksheets(1).Range("A1").Value < "" Then

Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = mybook.Worksheets(1).Range("A1").Value
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add mybook.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Display 'or use .Send
End With

If Err.Number 0 Then
ErrorYes = True
Err.Clear
On Error GoTo 0
End If

Else
ErrorYes = True
End If

'Save and close mybook
mybook.Close savechanges:=False
Else
'Not possible to open the workbook
ErrorYes = True
End If

Next Fnum
End If

If ErrorYes = True Then
MsgBox "There are problems in one or more files, possible
problem:" _
& vbNewLine & "???????????????"
End If

Set OutApp = Nothing

'Restore ScreenUpdating, Calculation and EnableEvents
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"jamesc" wrote in message
...
hi Ron!

Thank you for your response, as well as your website and tips, I've
learned so much from you!

I use Outlook 2003 for XP.

James


"Ron de Bruin" wrote in message
...
Hi James
Do you use Outlook or OE or Windows Mail

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"jamesc" wrote in message
...
hi everyone,

I have 80 workbooks in one folder. i'd like to be able to find a way
to automate opening each workbook, finding an email address in a1 and
create and send an email. i'd like for this to cycle through every
workbook in the folder. any ideas?

Thanks in advance!

James



Ron de Bruin

vba to send multiple workbooks to different address
 
Hi James

You are welcome

Add one line to my test code example (I forgot)
This line : Set OutMail = Nothing

Add it below End With


.Display 'or use .Send
End With
Set OutMail = Nothing


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"jamesc" wrote in message ...
Ron, this is perfect!!!
this absolutely does what i need! thanks so much!

James


"Ron de Bruin" wrote in message
...
'Save and close mybook
mybook.Close savechanges:=False

Must be

'Not Save and close mybook


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Ron de Bruin" wrote in message
...
Hi test this one
It will check cell a1of the first sheet of each workbook

Change this to your test folder with a few test files

MyPath = "C:\Users\Ron Desktop\test"

Change this to .Send if it is OK
.Display 'or use .Send




Sub Example()
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String, Fnum As Long
Dim mybook As Workbook
Dim CalcMode As Long
Dim sh As Worksheet
Dim ErrorYes As Boolean
Dim OutApp As Object
Dim OutMail As Object

'Fill in the path\folder where the files are
MyPath = "C:\Users\Ron Desktop\test"

'Add a slash at the end if the user forget it
If Right(MyPath, 1) < "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xl*")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath < ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop

'Change ScreenUpdating, Calculation and EnableEvents
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

Set OutApp = CreateObject("Outlook.Application")

'Loop through all files in the array(myFiles)
If Fnum 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
On Error GoTo 0

If Not mybook Is Nothing Then
If mybook.Worksheets(1).Range("A1").Value < "" Then

Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = mybook.Worksheets(1).Range("A1").Value
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add mybook.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Display 'or use .Send
End With

If Err.Number 0 Then
ErrorYes = True
Err.Clear
On Error GoTo 0
End If

Else
ErrorYes = True
End If

'Save and close mybook
mybook.Close savechanges:=False
Else
'Not possible to open the workbook
ErrorYes = True
End If

Next Fnum
End If

If ErrorYes = True Then
MsgBox "There are problems in one or more files, possible
problem:" _
& vbNewLine & "???????????????"
End If

Set OutApp = Nothing

'Restore ScreenUpdating, Calculation and EnableEvents
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"jamesc" wrote in message
...
hi Ron!

Thank you for your response, as well as your website and tips, I've
learned so much from you!

I use Outlook 2003 for XP.

James


"Ron de Bruin" wrote in message
...
Hi James
Do you use Outlook or OE or Windows Mail

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"jamesc" wrote in message
...
hi everyone,

I have 80 workbooks in one folder. i'd like to be able to find a way
to automate opening each workbook, finding an email address in a1 and
create and send an email. i'd like for this to cycle through every
workbook in the folder. any ideas?

Thanks in advance!

James



jamesc

vba to send multiple workbooks to different address
 
Ron, forgive me for being a pest, if i may ask one more request, the line
that calls out the specific folder, how do i change that to bring up an
"open" browser windows pop-up? in case here are files in different folders?
thanks a million!

James


"Ron de Bruin" wrote in message
...
Hi James

You are welcome

Add one line to my test code example (I forgot)
This line : Set OutMail = Nothing

Add it below End With


.Display 'or use .Send
End With
Set OutMail = Nothing


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"jamesc" wrote in message
...
Ron, this is perfect!!!
this absolutely does what i need! thanks so much!

James


"Ron de Bruin" wrote in message
...
'Save and close mybook
mybook.Close savechanges:=False

Must be

'Not Save and close mybook


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Ron de Bruin" wrote in message
...
Hi test this one
It will check cell a1of the first sheet of each workbook

Change this to your test folder with a few test files

MyPath = "C:\Users\Ron Desktop\test"

Change this to .Send if it is OK
.Display 'or use .Send




Sub Example()
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String, Fnum As Long
Dim mybook As Workbook
Dim CalcMode As Long
Dim sh As Worksheet
Dim ErrorYes As Boolean
Dim OutApp As Object
Dim OutMail As Object

'Fill in the path\folder where the files are
MyPath = "C:\Users\Ron Desktop\test"

'Add a slash at the end if the user forget it
If Right(MyPath, 1) < "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xl*")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath < ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop

'Change ScreenUpdating, Calculation and EnableEvents
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

Set OutApp = CreateObject("Outlook.Application")

'Loop through all files in the array(myFiles)
If Fnum 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
On Error GoTo 0

If Not mybook Is Nothing Then
If mybook.Worksheets(1).Range("A1").Value < "" Then

Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = mybook.Worksheets(1).Range("A1").Value
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add mybook.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Display 'or use .Send
End With

If Err.Number 0 Then
ErrorYes = True
Err.Clear
On Error GoTo 0
End If

Else
ErrorYes = True
End If

'Save and close mybook
mybook.Close savechanges:=False
Else
'Not possible to open the workbook
ErrorYes = True
End If

Next Fnum
End If

If ErrorYes = True Then
MsgBox "There are problems in one or more files, possible
problem:" _
& vbNewLine & "???????????????"
End If

Set OutApp = Nothing

'Restore ScreenUpdating, Calculation and EnableEvents
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"jamesc" wrote in message
...
hi Ron!

Thank you for your response, as well as your website and tips, I've
learned so much from you!

I use Outlook 2003 for XP.

James


"Ron de Bruin" wrote in message
...
Hi James
Do you use Outlook or OE or Windows Mail

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"jamesc" wrote in message
...
hi everyone,

I have 80 workbooks in one folder. i'd like to be able to find a way
to automate opening each workbook, finding an email address in a1
and create and send an email. i'd like for this to cycle through
every workbook in the folder. any ideas?

Thanks in advance!

James






All times are GMT +1. The time now is 10:58 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com