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

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

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

vba to send multiple workbooks to different address
 

Still use Ron's code for the email portion of the code. Add you code to
email each book inside the DO LOOP.

Folder = "c:\temp\" 'make sure there is a backslash at the end
FName = dir(Folder & "*.xls")
Do while FName < ""
Set EmailBk = Workbooks.open(filename:=Folder & FName)

EmailAddr = EmailBk.sheets("Sheet1").Range("A1")

EmailBk.close savechanges:=false

FName = dir()
loop


--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=170781

Microsoft Office Help

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

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

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

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

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

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

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

vba to send multiple workbooks to different address
 

I took this example from the VBA help under Filedialog. The only thing
I changed was from msoFileDialogFilePicker to msoFileDialogFolderPicker.
the code really calls the dll in the windows system32 folder. There
are two versions of the DLL and older one that is not size adjustable
and the new one the is size adjutable. Using the method below calls the
older version of the dialog. You have to call the DLL directly to get
the newer version.



Sub Main()

'Declare a variable as a FileDialog object.
Dim fd As FileDialog

'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFolderPicker)

'Declare a variable to contain the path
'of each selected item. Even though the path is a String,
'the variable must be a Variant because For Each...Next
'routines only work with Variants and Objects.
Dim vrtSelectedItem As Variant

'Use a With...End With block to reference the FileDialog object.
With fd

'Use the Show method to display the File Picker dialog box and
return the user's action.
'The user pressed the action button.
If .Show = -1 Then

'Step through each string in the FileDialogSelectedItems
collection.
For Each vrtSelectedItem In .SelectedItems

'vrtSelectedItem is a String that contains the path of
each selected item.
'You can use any file I/O functions that you want to
work with this path.
'This example simply displays the path in a message
box.
MsgBox "The path is: " & vrtSelectedItem

Next vrtSelectedItem
'The user pressed Cancel.
Else
End If
End With

'Set the object variable to Nothing.
Set fd = Nothing

End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=170781

Microsoft Office Help

vba to send multiple workbooks to different address
 

hi Joel, how or where do i include this in Ron's code posted earlier?
"joel" wrote in message
...

I took this example from the VBA help under Filedialog. The only thing
I changed was from msoFileDialogFilePicker to msoFileDialogFolderPicker.
the code really calls the dll in the windows system32 folder. There
are two versions of the DLL and older one that is not size adjustable
and the new one the is size adjutable. Using the method below calls the
older version of the dialog. You have to call the DLL directly to get
the newer version.



Sub Main()

'Declare a variable as a FileDialog object.
Dim fd As FileDialog

'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFolderPicker)

'Declare a variable to contain the path
'of each selected item. Even though the path is a String,
'the variable must be a Variant because For Each...Next
'routines only work with Variants and Objects.
Dim vrtSelectedItem As Variant

'Use a With...End With block to reference the FileDialog object.
With fd

'Use the Show method to display the File Picker dialog box and
return the user's action.
'The user pressed the action button.
If .Show = -1 Then

'Step through each string in the FileDialogSelectedItems
collection.
For Each vrtSelectedItem In .SelectedItems

'vrtSelectedItem is a String that contains the path of
each selected item.
'You can use any file I/O functions that you want to
work with this path.
'This example simply displays the path in a message
box.
MsgBox "The path is: " & vrtSelectedItem

Next vrtSelectedItem
'The user pressed Cancel.
Else
End If
End With

'Set the object variable to Nothing.
Set fd = Nothing

End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread:
http://www.thecodecage.com/forumz/sh...d.php?t=170781

Microsoft Office Help

vba to send multiple workbooks to different address
 

See the second example in the example workbook from my FSO page

Sub RDB_Merge_Data_Browse()
Dim myFiles As Variant
Dim myCountOfFiles As Long
Dim oApp As Object
Dim oFolder As Variant

Set oApp = CreateObject("Shell.Application")

'Browse to the folder
Set oFolder = oApp.BrowseForFolder(0, "Select folder", 512)
If Not oFolder Is Nothing Then

myCountOfFiles = Get_File_Names( _
MyPath:=oFolder.Self.Path, _
Subfolders:=False, _
ExtStr:="*.xl*", _
myReturnedFiles:=myFiles)

If myCountOfFiles = 0 Then
MsgBox "No files that match the ExtStr in this folder"
Exit Sub
End If

Get_Data _
FileNameInA:=True, _
PasteAsValues:=True, _
SourceShName:="", _
SourceShIndex:=1, _
SourceRng:="A1:G1", _
StartCell:="", _
myReturnedFiles:=myFiles

End If

End Sub


--

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


"jamesc" wrote in message ...
hi Joel, how or where do i include this in Ron's code posted earlier?
"joel" wrote in message
...

I took this example from the VBA help under Filedialog. The only thing
I changed was from msoFileDialogFilePicker to msoFileDialogFolderPicker.
the code really calls the dll in the windows system32 folder. There
are two versions of the DLL and older one that is not size adjustable
and the new one the is size adjutable. Using the method below calls the
older version of the dialog. You have to call the DLL directly to get
the newer version.



Sub Main()

'Declare a variable as a FileDialog object.
Dim fd As FileDialog

'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFolderPicker)

'Declare a variable to contain the path
'of each selected item. Even though the path is a String,
'the variable must be a Variant because For Each...Next
'routines only work with Variants and Objects.
Dim vrtSelectedItem As Variant

'Use a With...End With block to reference the FileDialog object.
With fd

'Use the Show method to display the File Picker dialog box and
return the user's action.
'The user pressed the action button.
If .Show = -1 Then

'Step through each string in the FileDialogSelectedItems
collection.
For Each vrtSelectedItem In .SelectedItems

'vrtSelectedItem is a String that contains the path of
each selected item.
'You can use any file I/O functions that you want to
work with this path.
'This example simply displays the path in a message
box.
MsgBox "The path is: " & vrtSelectedItem

Next vrtSelectedItem
'The user pressed Cancel.
Else
End If
End With

'Set the object variable to Nothing.
Set fd = Nothing

End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread:
http://www.thecodecage.com/forumz/sh...d.php?t=170781

Microsoft Office Help

vba to send multiple workbooks to different address
 

Oops

I post a wrong example here
I mixed two newsgroup postings

I post a example for today

--

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


"Ron de Bruin" wrote in message ...
See the second example in the example workbook from my FSO page

Sub RDB_Merge_Data_Browse()
Dim myFiles As Variant
Dim myCountOfFiles As Long
Dim oApp As Object
Dim oFolder As Variant

Set oApp = CreateObject("Shell.Application")

'Browse to the folder
Set oFolder = oApp.BrowseForFolder(0, "Select folder", 512)
If Not oFolder Is Nothing Then

myCountOfFiles = Get_File_Names( _
MyPath:=oFolder.Self.Path, _
Subfolders:=False, _
ExtStr:="*.xl*", _
myReturnedFiles:=myFiles)

If myCountOfFiles = 0 Then
MsgBox "No files that match the ExtStr in this folder"
Exit Sub
End If

Get_Data _
FileNameInA:=True, _
PasteAsValues:=True, _
SourceShName:="", _
SourceShIndex:=1, _
SourceRng:="A1:G1", _
StartCell:="", _
myReturnedFiles:=myFiles

End If

End Sub


--

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


"jamesc" wrote in message ...
hi Joel, how or where do i include this in Ron's code posted earlier?
"joel" wrote in message
...

I took this example from the VBA help under Filedialog. The only thing
I changed was from msoFileDialogFilePicker to msoFileDialogFolderPicker.
the code really calls the dll in the windows system32 folder. There
are two versions of the DLL and older one that is not size adjustable
and the new one the is size adjutable. Using the method below calls the
older version of the dialog. You have to call the DLL directly to get
the newer version.



Sub Main()

'Declare a variable as a FileDialog object.
Dim fd As FileDialog

'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFolderPicker)

'Declare a variable to contain the path
'of each selected item. Even though the path is a String,
'the variable must be a Variant because For Each...Next
'routines only work with Variants and Objects.
Dim vrtSelectedItem As Variant

'Use a With...End With block to reference the FileDialog object.
With fd

'Use the Show method to display the File Picker dialog box and
return the user's action.
'The user pressed the action button.
If .Show = -1 Then

'Step through each string in the FileDialogSelectedItems
collection.
For Each vrtSelectedItem In .SelectedItems

'vrtSelectedItem is a String that contains the path of
each selected item.
'You can use any file I/O functions that you want to
work with this path.
'This example simply displays the path in a message
box.
MsgBox "The path is: " & vrtSelectedItem

Next vrtSelectedItem
'The user pressed Cancel.
Else
End If
End With

'Set the object variable to Nothing.
Set fd = Nothing

End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread:
http://www.thecodecage.com/forumz/sh...d.php?t=170781

Microsoft Office Help

vba to send multiple workbooks to different address
 

Test this one

Sub Example_2()
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
Dim oApp As Object
Dim oFolder As Variant

Set oApp = CreateObject("Shell.Application")

'Browse to the folder
Set oFolder = oApp.BrowseForFolder(0, "Select folder", 512)
If Not oFolder Is Nothing Then

'Fill in the path\folder where the files are
MyPath = oFolder.Self.Path

'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
Set OutMail = Nothing

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

Else
ErrorYes = True
End If

'Close mybook without saving
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 If
End Sub



--

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


"Ron de Bruin" wrote in message ...
Oops

I post a wrong example here
I mixed two newsgroup postings

I post a example for today

--

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


"Ron de Bruin" wrote in message ...
See the second example in the example workbook from my FSO page

Sub RDB_Merge_Data_Browse()
Dim myFiles As Variant
Dim myCountOfFiles As Long
Dim oApp As Object
Dim oFolder As Variant

Set oApp = CreateObject("Shell.Application")

'Browse to the folder
Set oFolder = oApp.BrowseForFolder(0, "Select folder", 512)
If Not oFolder Is Nothing Then

myCountOfFiles = Get_File_Names( _
MyPath:=oFolder.Self.Path, _
Subfolders:=False, _
ExtStr:="*.xl*", _
myReturnedFiles:=myFiles)

If myCountOfFiles = 0 Then
MsgBox "No files that match the ExtStr in this folder"
Exit Sub
End If

Get_Data _
FileNameInA:=True, _
PasteAsValues:=True, _
SourceShName:="", _
SourceShIndex:=1, _
SourceRng:="A1:G1", _
StartCell:="", _
myReturnedFiles:=myFiles

End If

End Sub


--

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


"jamesc" wrote in message ...
hi Joel, how or where do i include this in Ron's code posted earlier?
"joel" wrote in message
...

I took this example from the VBA help under Filedialog. The only thing
I changed was from msoFileDialogFilePicker to msoFileDialogFolderPicker.
the code really calls the dll in the windows system32 folder. There
are two versions of the DLL and older one that is not size adjustable
and the new one the is size adjutable. Using the method below calls the
older version of the dialog. You have to call the DLL directly to get
the newer version.



Sub Main()

'Declare a variable as a FileDialog object.
Dim fd As FileDialog

'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFolderPicker)

'Declare a variable to contain the path
'of each selected item. Even though the path is a String,
'the variable must be a Variant because For Each...Next
'routines only work with Variants and Objects.
Dim vrtSelectedItem As Variant

'Use a With...End With block to reference the FileDialog object.
With fd

'Use the Show method to display the File Picker dialog box and
return the user's action.
'The user pressed the action button.
If .Show = -1 Then

'Step through each string in the FileDialogSelectedItems
collection.
For Each vrtSelectedItem In .SelectedItems

'vrtSelectedItem is a String that contains the path of
each selected item.
'You can use any file I/O functions that you want to
work with this path.
'This example simply displays the path in a message
box.
MsgBox "The path is: " & vrtSelectedItem

Next vrtSelectedItem
'The user pressed Cancel.
Else
End If
End With

'Set the object variable to Nothing.
Set fd = Nothing

End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread:
http://www.thecodecage.com/forumz/sh...d.php?t=170781

Microsoft Office Help

vba to send multiple workbooks to different address
 

Ron has a variable MyPath. The FileDialog code returns vrtSelectedItem
So you just have to put my code first (before Ron's) and change the
following
in my code vrtSelectedItem to Myfolder.


--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=170781

Microsoft Office Help

vba to send multiple workbooks to different address
 

Worked perfectly!

I really appreciate all your effort! i was able to step through all the code
and make some small changes (customized the subject and body text). Feel
like i'm learning a lot from this! thank you so much!
On your website, is there anywhere that you discuss mixing text with range
data together to appear as text?



"Ron de Bruin" wrote in message
...
Test this one

Sub Example_2()
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
Dim oApp As Object
Dim oFolder As Variant

Set oApp = CreateObject("Shell.Application")

'Browse to the folder
Set oFolder = oApp.BrowseForFolder(0, "Select folder", 512)
If Not oFolder Is Nothing Then

'Fill in the path\folder where the files are
MyPath = oFolder.Self.Path

'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
Set OutMail = Nothing

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

Else
ErrorYes = True
End If

'Close mybook without saving
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 If
End Sub



--

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


"Ron de Bruin" wrote in message
...
Oops

I post a wrong example here
I mixed two newsgroup postings

I post a example for today

--

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


"Ron de Bruin" wrote in message
...
See the second example in the example workbook from my FSO page

Sub RDB_Merge_Data_Browse()
Dim myFiles As Variant
Dim myCountOfFiles As Long
Dim oApp As Object
Dim oFolder As Variant

Set oApp = CreateObject("Shell.Application")

'Browse to the folder
Set oFolder = oApp.BrowseForFolder(0, "Select folder", 512)
If Not oFolder Is Nothing Then

myCountOfFiles = Get_File_Names( _
MyPath:=oFolder.Self.Path, _
Subfolders:=False, _
ExtStr:="*.xl*", _
myReturnedFiles:=myFiles)

If myCountOfFiles = 0 Then
MsgBox "No files that match the ExtStr in this folder"
Exit Sub
End If

Get_Data _
FileNameInA:=True, _
PasteAsValues:=True, _
SourceShName:="", _
SourceShIndex:=1, _
SourceRng:="A1:G1", _
StartCell:="", _
myReturnedFiles:=myFiles

End If

End Sub


--

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


"jamesc" wrote in message
...
hi Joel, how or where do i include this in Ron's code posted earlier?
"joel" wrote in message
...

I took this example from the VBA help under Filedialog. The only
thing
I changed was from msoFileDialogFilePicker to
msoFileDialogFolderPicker.
the code really calls the dll in the windows system32 folder. There
are two versions of the DLL and older one that is not size adjustable
and the new one the is size adjutable. Using the method below calls
the
older version of the dialog. You have to call the DLL directly to get
the newer version.



Sub Main()

'Declare a variable as a FileDialog object.
Dim fd As FileDialog

'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFolderPicker)

'Declare a variable to contain the path
'of each selected item. Even though the path is a String,
'the variable must be a Variant because For Each...Next
'routines only work with Variants and Objects.
Dim vrtSelectedItem As Variant

'Use a With...End With block to reference the FileDialog object.
With fd

'Use the Show method to display the File Picker dialog box and
return the user's action.
'The user pressed the action button.
If .Show = -1 Then

'Step through each string in the FileDialogSelectedItems
collection.
For Each vrtSelectedItem In .SelectedItems

'vrtSelectedItem is a String that contains the path of
each selected item.
'You can use any file I/O functions that you want to
work with this path.
'This example simply displays the path in a message
box.
MsgBox "The path is: " & vrtSelectedItem

Next vrtSelectedItem
'The user pressed Cancel.
Else
End If
End With

'Set the object variable to Nothing.
Set fd = Nothing

End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread:
http://www.thecodecage.com/forumz/sh...d.php?t=170781

Microsoft Office
Help

vba to send multiple workbooks to different address
 

Hi James

Are the cells that you want to use in the body string in the workbook with the code
Or do you want to use the cells in the workbooks you send
So that every mail have a different body string



--

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


"jamesc" wrote in message ...
Worked perfectly!

I really appreciate all your effort! i was able to step through all the code
and make some small changes (customized the subject and body text). Feel
like i'm learning a lot from this! thank you so much!
On your website, is there anywhere that you discuss mixing text with range
data together to appear as text?



"Ron de Bruin" wrote in message
...
Test this one

Sub Example_2()
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
Dim oApp As Object
Dim oFolder As Variant

Set oApp = CreateObject("Shell.Application")

'Browse to the folder
Set oFolder = oApp.BrowseForFolder(0, "Select folder", 512)
If Not oFolder Is Nothing Then

'Fill in the path\folder where the files are
MyPath = oFolder.Self.Path

'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
Set OutMail = Nothing

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

Else
ErrorYes = True
End If

'Close mybook without saving
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 If
End Sub



--

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


"Ron de Bruin" wrote in message
...
Oops

I post a wrong example here
I mixed two newsgroup postings

I post a example for today

--

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


"Ron de Bruin" wrote in message
...
See the second example in the example workbook from my FSO page

Sub RDB_Merge_Data_Browse()
Dim myFiles As Variant
Dim myCountOfFiles As Long
Dim oApp As Object
Dim oFolder As Variant

Set oApp = CreateObject("Shell.Application")

'Browse to the folder
Set oFolder = oApp.BrowseForFolder(0, "Select folder", 512)
If Not oFolder Is Nothing Then

myCountOfFiles = Get_File_Names( _
MyPath:=oFolder.Self.Path, _
Subfolders:=False, _
ExtStr:="*.xl*", _
myReturnedFiles:=myFiles)

If myCountOfFiles = 0 Then
MsgBox "No files that match the ExtStr in this folder"
Exit Sub
End If

Get_Data _
FileNameInA:=True, _
PasteAsValues:=True, _
SourceShName:="", _
SourceShIndex:=1, _
SourceRng:="A1:G1", _
StartCell:="", _
myReturnedFiles:=myFiles

End If

End Sub


--

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


"jamesc" wrote in message
...
hi Joel, how or where do i include this in Ron's code posted earlier?
"joel" wrote in message
...

I took this example from the VBA help under Filedialog. The only
thing
I changed was from msoFileDialogFilePicker to
msoFileDialogFolderPicker.
the code really calls the dll in the windows system32 folder. There
are two versions of the DLL and older one that is not size adjustable
and the new one the is size adjutable. Using the method below calls
the
older version of the dialog. You have to call the DLL directly to get
the newer version.



Sub Main()

'Declare a variable as a FileDialog object.
Dim fd As FileDialog

'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFolderPicker)

'Declare a variable to contain the path
'of each selected item. Even though the path is a String,
'the variable must be a Variant because For Each...Next
'routines only work with Variants and Objects.
Dim vrtSelectedItem As Variant

'Use a With...End With block to reference the FileDialog object.
With fd

'Use the Show method to display the File Picker dialog box and
return the user's action.
'The user pressed the action button.
If .Show = -1 Then

'Step through each string in the FileDialogSelectedItems
collection.
For Each vrtSelectedItem In .SelectedItems

'vrtSelectedItem is a String that contains the path of
each selected item.
'You can use any file I/O functions that you want to
work with this path.
'This example simply displays the path in a message
box.
MsgBox "The path is: " & vrtSelectedItem

Next vrtSelectedItem
'The user pressed Cancel.
Else
End If
End With

'Set the object variable to Nothing.
Set fd = Nothing

End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread:
http://www.thecodecage.com/forumz/sh...d.php?t=170781

Microsoft Office
Help

vba to send multiple workbooks to different address
 

Thanks Joel for your responses! Ron provided me with what i needed, but i do
appreciate you taking the time as well!
James
"joel" wrote in message
...

Ron has a variable MyPath. The FileDialog code returns vrtSelectedItem
So you just have to put my code first (before Ron's) and change the
following
in my code vrtSelectedItem to Myfolder.


--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread:
http://www.thecodecage.com/forumz/sh...d.php?t=170781

Microsoft Office Help

vba to send multiple workbooks to different address
 

in the body part of your example i would like to add custom text, mixed with
text from the workbook.

example: Hi, you are not able to order the followin products: (range from a
pivot table, ie A3:a100)


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

Are the cells that you want to use in the body string in the workbook with
the code Or do you want to use the cells in the workbooks you send
So that every mail have a different body string



--

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


"jamesc" wrote in message
...
Worked perfectly!

I really appreciate all your effort! i was able to step through all the
code and make some small changes (customized the subject and body text).
Feel like i'm learning a lot from this! thank you so much!
On your website, is there anywhere that you discuss mixing text with
range data together to appear as text?



"Ron de Bruin" wrote in message
...
Test this one

Sub Example_2()
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
Dim oApp As Object
Dim oFolder As Variant

Set oApp = CreateObject("Shell.Application")

'Browse to the folder
Set oFolder = oApp.BrowseForFolder(0, "Select folder", 512)
If Not oFolder Is Nothing Then

'Fill in the path\folder where the files are
MyPath = oFolder.Self.Path

'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
Set OutMail = Nothing

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

Else
ErrorYes = True
End If

'Close mybook without saving
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 If
End Sub



--

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


"Ron de Bruin" wrote in message
...
Oops

I post a wrong example here
I mixed two newsgroup postings

I post a example for today

--

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


"Ron de Bruin" wrote in message
...
See the second example in the example workbook from my FSO page

Sub RDB_Merge_Data_Browse()
Dim myFiles As Variant
Dim myCountOfFiles As Long
Dim oApp As Object
Dim oFolder As Variant

Set oApp = CreateObject("Shell.Application")

'Browse to the folder
Set oFolder = oApp.BrowseForFolder(0, "Select folder", 512)
If Not oFolder Is Nothing Then

myCountOfFiles = Get_File_Names( _
MyPath:=oFolder.Self.Path, _
Subfolders:=False, _
ExtStr:="*.xl*", _
myReturnedFiles:=myFiles)

If myCountOfFiles = 0 Then
MsgBox "No files that match the ExtStr in this folder"
Exit Sub
End If

Get_Data _
FileNameInA:=True, _
PasteAsValues:=True, _
SourceShName:="", _
SourceShIndex:=1, _
SourceRng:="A1:G1", _
StartCell:="", _
myReturnedFiles:=myFiles

End If

End Sub


--

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


"jamesc" wrote in message
...
hi Joel, how or where do i include this in Ron's code posted earlier?
"joel" wrote in message
...

I took this example from the VBA help under Filedialog. The only
thing
I changed was from msoFileDialogFilePicker to
msoFileDialogFolderPicker.
the code really calls the dll in the windows system32 folder.
There
are two versions of the DLL and older one that is not size
adjustable
and the new one the is size adjutable. Using the method below calls
the
older version of the dialog. You have to call the DLL directly to
get
the newer version.



Sub Main()

'Declare a variable as a FileDialog object.
Dim fd As FileDialog

'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFolderPicker)

'Declare a variable to contain the path
'of each selected item. Even though the path is a String,
'the variable must be a Variant because For Each...Next
'routines only work with Variants and Objects.
Dim vrtSelectedItem As Variant

'Use a With...End With block to reference the FileDialog object.
With fd

'Use the Show method to display the File Picker dialog box and
return the user's action.
'The user pressed the action button.
If .Show = -1 Then

'Step through each string in the FileDialogSelectedItems
collection.
For Each vrtSelectedItem In .SelectedItems

'vrtSelectedItem is a String that contains the path of
each selected item.
'You can use any file I/O functions that you want to
work with this path.
'This example simply displays the path in a message
box.
MsgBox "The path is: " & vrtSelectedItem

Next vrtSelectedItem
'The user pressed Cancel.
Else
End If
End With

'Set the object variable to Nothing.
Set fd = Nothing

End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread:
http://www.thecodecage.com/forumz/sh...d.php?t=170781

Microsoft Office
Help

vba to send multiple workbooks to different address
 

Where is that range

In the workbook with the code

Or in each workbook you open and send by mail

--

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


"jamesc" wrote in message ...
in the body part of your example i would like to add custom text, mixed with
text from the workbook.

example: Hi, you are not able to order the followin products: (range from a
pivot table, ie A3:a100)


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

Are the cells that you want to use in the body string in the workbook with
the code Or do you want to use the cells in the workbooks you send
So that every mail have a different body string



--

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


"jamesc" wrote in message
...
Worked perfectly!

I really appreciate all your effort! i was able to step through all the
code and make some small changes (customized the subject and body text).
Feel like i'm learning a lot from this! thank you so much!
On your website, is there anywhere that you discuss mixing text with
range data together to appear as text?



"Ron de Bruin" wrote in message
...
Test this one

Sub Example_2()
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
Dim oApp As Object
Dim oFolder As Variant

Set oApp = CreateObject("Shell.Application")

'Browse to the folder
Set oFolder = oApp.BrowseForFolder(0, "Select folder", 512)
If Not oFolder Is Nothing Then

'Fill in the path\folder where the files are
MyPath = oFolder.Self.Path

'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
Set OutMail = Nothing

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

Else
ErrorYes = True
End If

'Close mybook without saving
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 If
End Sub



--

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


"Ron de Bruin" wrote in message
...
Oops

I post a wrong example here
I mixed two newsgroup postings

I post a example for today

--

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


"Ron de Bruin" wrote in message
...
See the second example in the example workbook from my FSO page

Sub RDB_Merge_Data_Browse()
Dim myFiles As Variant
Dim myCountOfFiles As Long
Dim oApp As Object
Dim oFolder As Variant

Set oApp = CreateObject("Shell.Application")

'Browse to the folder
Set oFolder = oApp.BrowseForFolder(0, "Select folder", 512)
If Not oFolder Is Nothing Then

myCountOfFiles = Get_File_Names( _
MyPath:=oFolder.Self.Path, _
Subfolders:=False, _
ExtStr:="*.xl*", _
myReturnedFiles:=myFiles)

If myCountOfFiles = 0 Then
MsgBox "No files that match the ExtStr in this folder"
Exit Sub
End If

Get_Data _
FileNameInA:=True, _
PasteAsValues:=True, _
SourceShName:="", _
SourceShIndex:=1, _
SourceRng:="A1:G1", _
StartCell:="", _
myReturnedFiles:=myFiles

End If

End Sub


--

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


"jamesc" wrote in message
...
hi Joel, how or where do i include this in Ron's code posted earlier?
"joel" wrote in message
...

I took this example from the VBA help under Filedialog. The only
thing
I changed was from msoFileDialogFilePicker to
msoFileDialogFolderPicker.
the code really calls the dll in the windows system32 folder.
There
are two versions of the DLL and older one that is not size
adjustable
and the new one the is size adjutable. Using the method below calls
the
older version of the dialog. You have to call the DLL directly to
get
the newer version.



Sub Main()

'Declare a variable as a FileDialog object.
Dim fd As FileDialog

'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFolderPicker)

'Declare a variable to contain the path
'of each selected item. Even though the path is a String,
'the variable must be a Variant because For Each...Next
'routines only work with Variants and Objects.
Dim vrtSelectedItem As Variant

'Use a With...End With block to reference the FileDialog object.
With fd

'Use the Show method to display the File Picker dialog box and
return the user's action.
'The user pressed the action button.
If .Show = -1 Then

'Step through each string in the FileDialogSelectedItems
collection.
For Each vrtSelectedItem In .SelectedItems

'vrtSelectedItem is a String that contains the path of
each selected item.
'You can use any file I/O functions that you want to
work with this path.
'This example simply displays the path in a message
box.
MsgBox "The path is: " & vrtSelectedItem

Next vrtSelectedItem
'The user pressed Cancel.
Else
End If
End With

'Set the object variable to Nothing.
Set fd = Nothing

End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread:
http://www.thecodecage.com/forumz/sh...d.php?t=170781

Microsoft Office
Help

vba to send multiple workbooks to different address
 

Not sure if my last post went through or not so i will try again :-)

Ron,
the range is located in each workbook i open and send by email. so the data
could be different in each email body. because i am using a range from a
pivot table, i was hoping that it would only grab actual text and not all
the blank cells in between.

"Ron de Bruin" wrote in message
...
Where is that range

In the workbook with the code

Or in each workbook you open and send by mail

--

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


"jamesc" wrote in message
...
in the body part of your example i would like to add custom text, mixed
with text from the workbook.

example: Hi, you are not able to order the followin products: (range from
a pivot table, ie A3:a100)


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

Are the cells that you want to use in the body string in the workbook
with the code Or do you want to use the cells in the workbooks you send
So that every mail have a different body string



--

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


"jamesc" wrote in message
...
Worked perfectly!

I really appreciate all your effort! i was able to step through all the
code and make some small changes (customized the subject and body
text). Feel like i'm learning a lot from this! thank you so much!
On your website, is there anywhere that you discuss mixing text with
range data together to appear as text?



"Ron de Bruin" wrote in message
...
Test this one

Sub Example_2()
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
Dim oApp As Object
Dim oFolder As Variant

Set oApp = CreateObject("Shell.Application")

'Browse to the folder
Set oFolder = oApp.BrowseForFolder(0, "Select folder", 512)
If Not oFolder Is Nothing Then

'Fill in the path\folder where the files are
MyPath = oFolder.Self.Path

'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
Set OutMail = Nothing

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

Else
ErrorYes = True
End If

'Close mybook without saving
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 If
End Sub



--

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


"Ron de Bruin" wrote in message
...
Oops

I post a wrong example here
I mixed two newsgroup postings

I post a example for today

--

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


"Ron de Bruin" wrote in message
...
See the second example in the example workbook from my FSO page

Sub RDB_Merge_Data_Browse()
Dim myFiles As Variant
Dim myCountOfFiles As Long
Dim oApp As Object
Dim oFolder As Variant

Set oApp = CreateObject("Shell.Application")

'Browse to the folder
Set oFolder = oApp.BrowseForFolder(0, "Select folder", 512)
If Not oFolder Is Nothing Then

myCountOfFiles = Get_File_Names( _
MyPath:=oFolder.Self.Path, _
Subfolders:=False, _
ExtStr:="*.xl*", _
myReturnedFiles:=myFiles)

If myCountOfFiles = 0 Then
MsgBox "No files that match the ExtStr in this folder"
Exit Sub
End If

Get_Data _
FileNameInA:=True, _
PasteAsValues:=True, _
SourceShName:="", _
SourceShIndex:=1, _
SourceRng:="A1:G1", _
StartCell:="", _
myReturnedFiles:=myFiles

End If

End Sub


--

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


"jamesc" wrote in message
...
hi Joel, how or where do i include this in Ron's code posted
earlier?
"joel" wrote in message
...

I took this example from the VBA help under Filedialog. The only
thing
I changed was from msoFileDialogFilePicker to
msoFileDialogFolderPicker.
the code really calls the dll in the windows system32 folder.
There
are two versions of the DLL and older one that is not size
adjustable
and the new one the is size adjutable. Using the method below
calls the
older version of the dialog. You have to call the DLL directly to
get
the newer version.



Sub Main()

'Declare a variable as a FileDialog object.
Dim fd As FileDialog

'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFolderPicker)

'Declare a variable to contain the path
'of each selected item. Even though the path is a String,
'the variable must be a Variant because For Each...Next
'routines only work with Variants and Objects.
Dim vrtSelectedItem As Variant

'Use a With...End With block to reference the FileDialog object.
With fd

'Use the Show method to display the File Picker dialog box and
return the user's action.
'The user pressed the action button.
If .Show = -1 Then

'Step through each string in the FileDialogSelectedItems
collection.
For Each vrtSelectedItem In .SelectedItems

'vrtSelectedItem is a String that contains the path of
each selected item.
'You can use any file I/O functions that you want to
work with this path.
'This example simply displays the path in a message
box.
MsgBox "The path is: " & vrtSelectedItem

Next vrtSelectedItem
'The user pressed Cancel.
Else
End If
End With

'Set the object variable to Nothing.
Set fd = Nothing

End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread:
http://www.thecodecage.com/forumz/sh...d.php?t=170781

Microsoft Office
Help

vba to send multiple workbooks to different address
 

See this part in the code

With mybook.Worksheets(1)
strbody = "Hi there" & vbNewLine & vbNewLine & _
.Range("A1") & vbNewLine & _
.Range("A2") & vbNewLine & _
.Range("A3") & vbNewLine & _
.Range("A4")
End With

Sub Example_3()
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
Dim oApp As Object
Dim oFolder As Variant
Dim strbody As String

Set oApp = CreateObject("Shell.Application")

'Browse to the folder
Set oFolder = oApp.BrowseForFolder(0, "Select folder", 512)
If Not oFolder Is Nothing Then

'Fill in the path\folder where the files are
MyPath = oFolder.Self.Path

'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

With mybook.Worksheets(1)
strbody = "Hi there" & vbNewLine & vbNewLine & _
.Range("A1") & vbNewLine & _
.Range("A2") & vbNewLine & _
.Range("A3") & vbNewLine & _
.Range("A4")
End With

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 = strbody
.Attachments.Add mybook.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Display 'or use .Display
End With
Set OutMail = Nothing

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 If
End Sub




--

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


"jamesc" wrote in message ...
Not sure if my last post went through or not so i will try again :-)

Ron,
the range is located in each workbook i open and send by email. so the data
could be different in each email body. because i am using a range from a
pivot table, i was hoping that it would only grab actual text and not all
the blank cells in between.

"Ron de Bruin" wrote in message
...
Where is that range

In the workbook with the code

Or in each workbook you open and send by mail

--

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


"jamesc" wrote in message
...
in the body part of your example i would like to add custom text, mixed
with text from the workbook.

example: Hi, you are not able to order the followin products: (range from
a pivot table, ie A3:a100)


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

Are the cells that you want to use in the body string in the workbook
with the code Or do you want to use the cells in the workbooks you send
So that every mail have a different body string



--

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


"jamesc" wrote in message
...
Worked perfectly!

I really appreciate all your effort! i was able to step through all the
code and make some small changes (customized the subject and body
text). Feel like i'm learning a lot from this! thank you so much!
On your website, is there anywhere that you discuss mixing text with
range data together to appear as text?



"Ron de Bruin" wrote in message
...
Test this one

Sub Example_2()
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
Dim oApp As Object
Dim oFolder As Variant

Set oApp = CreateObject("Shell.Application")

'Browse to the folder
Set oFolder = oApp.BrowseForFolder(0, "Select folder", 512)
If Not oFolder Is Nothing Then

'Fill in the path\folder where the files are
MyPath = oFolder.Self.Path

'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
Set OutMail = Nothing

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

Else
ErrorYes = True
End If

'Close mybook without saving
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 If
End Sub



--

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


"Ron de Bruin" wrote in message
...
Oops

I post a wrong example here
I mixed two newsgroup postings

I post a example for today

--

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


"Ron de Bruin" wrote in message
...
See the second example in the example workbook from my FSO page

Sub RDB_Merge_Data_Browse()
Dim myFiles As Variant
Dim myCountOfFiles As Long
Dim oApp As Object
Dim oFolder As Variant

Set oApp = CreateObject("Shell.Application")

'Browse to the folder
Set oFolder = oApp.BrowseForFolder(0, "Select folder", 512)
If Not oFolder Is Nothing Then

myCountOfFiles = Get_File_Names( _
MyPath:=oFolder.Self.Path, _
Subfolders:=False, _
ExtStr:="*.xl*", _
myReturnedFiles:=myFiles)

If myCountOfFiles = 0 Then
MsgBox "No files that match the ExtStr in this folder"
Exit Sub
End If

Get_Data _
FileNameInA:=True, _
PasteAsValues:=True, _
SourceShName:="", _
SourceShIndex:=1, _
SourceRng:="A1:G1", _
StartCell:="", _
myReturnedFiles:=myFiles

End If

End Sub


--

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


"jamesc" wrote in message
...
hi Joel, how or where do i include this in Ron's code posted
earlier?
"joel" wrote in message
...

I took this example from the VBA help under Filedialog. The only
thing
I changed was from msoFileDialogFilePicker to
msoFileDialogFolderPicker.
the code really calls the dll in the windows system32 folder.
There
are two versions of the DLL and older one that is not size
adjustable
and the new one the is size adjutable. Using the method below
calls the
older version of the dialog. You have to call the DLL directly to
get
the newer version.



Sub Main()

'Declare a variable as a FileDialog object.
Dim fd As FileDialog

'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFolderPicker)

'Declare a variable to contain the path
'of each selected item. Even though the path is a String,
'the variable must be a Variant because For Each...Next
'routines only work with Variants and Objects.
Dim vrtSelectedItem As Variant

'Use a With...End With block to reference the FileDialog object.
With fd

'Use the Show method to display the File Picker dialog box and
return the user's action.
'The user pressed the action button.
If .Show = -1 Then

'Step through each string in the FileDialogSelectedItems
collection.
For Each vrtSelectedItem In .SelectedItems

'vrtSelectedItem is a String that contains the path of
each selected item.
'You can use any file I/O functions that you want to
work with this path.
'This example simply displays the path in a message
box.
MsgBox "The path is: " & vrtSelectedItem

Next vrtSelectedItem
'The user pressed Cancel.
Else
End If
End With

'Set the object variable to Nothing.
Set fd = Nothing

End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread:
http://www.thecodecage.com/forumz/sh...d.php?t=170781

Microsoft Office
Help

vba to send multiple workbooks to different address
 

Ron, this works, but it seems like there is only a limit of cells i can do
thhis with. is there no way to grab an actual range of cells, like A3:A50?


"Ron de Bruin" wrote in message
...
See this part in the code

With mybook.Worksheets(1)
strbody = "Hi there" & vbNewLine & vbNewLine &
_
.Range("A1") & vbNewLine & _
.Range("A2") & vbNewLine & _
.Range("A3") & vbNewLine & _
.Range("A4")
End With

Sub Example_3()
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
Dim oApp As Object
Dim oFolder As Variant
Dim strbody As String

Set oApp = CreateObject("Shell.Application")

'Browse to the folder
Set oFolder = oApp.BrowseForFolder(0, "Select folder", 512)
If Not oFolder Is Nothing Then

'Fill in the path\folder where the files are
MyPath = oFolder.Self.Path

'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

With mybook.Worksheets(1)
strbody = "Hi there" & vbNewLine & vbNewLine &
_
.Range("A1") & vbNewLine & _
.Range("A2") & vbNewLine & _
.Range("A3") & vbNewLine & _
.Range("A4")
End With

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 = strbody
.Attachments.Add mybook.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Display 'or use .Display
End With
Set OutMail = Nothing

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 If
End Sub




--

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


"jamesc" wrote in message
...
Not sure if my last post went through or not so i will try again :-)

Ron,
the range is located in each workbook i open and send by email. so the
data could be different in each email body. because i am using a range
from a pivot table, i was hoping that it would only grab actual text and
not all the blank cells in between.

"Ron de Bruin" wrote in message
...
Where is that range

In the workbook with the code

Or in each workbook you open and send by mail

--

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


"jamesc" wrote in message
...
in the body part of your example i would like to add custom text, mixed
with text from the workbook.

example: Hi, you are not able to order the followin products: (range
from a pivot table, ie A3:a100)


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

Are the cells that you want to use in the body string in the workbook
with the code Or do you want to use the cells in the workbooks you
send
So that every mail have a different body string



--

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


"jamesc" wrote in message
...
Worked perfectly!

I really appreciate all your effort! i was able to step through all
the code and make some small changes (customized the subject and body
text). Feel like i'm learning a lot from this! thank you so much!
On your website, is there anywhere that you discuss mixing text with
range data together to appear as text?



"Ron de Bruin" wrote in message
...
Test this one

Sub Example_2()
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
Dim oApp As Object
Dim oFolder As Variant

Set oApp = CreateObject("Shell.Application")

'Browse to the folder
Set oFolder = oApp.BrowseForFolder(0, "Select folder", 512)
If Not oFolder Is Nothing Then

'Fill in the path\folder where the files are
MyPath = oFolder.Self.Path

'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
Set OutMail = Nothing

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

Else
ErrorYes = True
End If

'Close mybook without saving
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 If
End Sub



--

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


"Ron de Bruin" wrote in message
...
Oops

I post a wrong example here
I mixed two newsgroup postings

I post a example for today

--

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


"Ron de Bruin" wrote in message
...
See the second example in the example workbook from my FSO page

Sub RDB_Merge_Data_Browse()
Dim myFiles As Variant
Dim myCountOfFiles As Long
Dim oApp As Object
Dim oFolder As Variant

Set oApp = CreateObject("Shell.Application")

'Browse to the folder
Set oFolder = oApp.BrowseForFolder(0, "Select folder", 512)
If Not oFolder Is Nothing Then

myCountOfFiles = Get_File_Names( _
MyPath:=oFolder.Self.Path, _
Subfolders:=False, _
ExtStr:="*.xl*", _
myReturnedFiles:=myFiles)

If myCountOfFiles = 0 Then
MsgBox "No files that match the ExtStr in this folder"
Exit Sub
End If

Get_Data _
FileNameInA:=True, _
PasteAsValues:=True, _
SourceShName:="", _
SourceShIndex:=1, _
SourceRng:="A1:G1", _
StartCell:="", _
myReturnedFiles:=myFiles

End If

End Sub


--

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


"jamesc" wrote in message
...
hi Joel, how or where do i include this in Ron's code posted
earlier?
"joel" wrote in message
...

I took this example from the VBA help under Filedialog. The
only thing
I changed was from msoFileDialogFilePicker to
msoFileDialogFolderPicker.
the code really calls the dll in the windows system32 folder.
There
are two versions of the DLL and older one that is not size
adjustable
and the new one the is size adjutable. Using the method below
calls the
older version of the dialog. You have to call the DLL directly
to get
the newer version.



Sub Main()

'Declare a variable as a FileDialog object.
Dim fd As FileDialog

'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFolderPicker)

'Declare a variable to contain the path
'of each selected item. Even though the path is a String,
'the variable must be a Variant because For Each...Next
'routines only work with Variants and Objects.
Dim vrtSelectedItem As Variant

'Use a With...End With block to reference the FileDialog object.
With fd

'Use the Show method to display the File Picker dialog box and
return the user's action.
'The user pressed the action button.
If .Show = -1 Then

'Step through each string in the FileDialogSelectedItems
collection.
For Each vrtSelectedItem In .SelectedItems

'vrtSelectedItem is a String that contains the path of
each selected item.
'You can use any file I/O functions that you want to
work with this path.
'This example simply displays the path in a message
box.
MsgBox "The path is: " & vrtSelectedItem

Next vrtSelectedItem
'The user pressed Cancel.
Else
End If
End With

'Set the object variable to Nothing.
Set fd = Nothing

End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread:
http://www.thecodecage.com/forumz/sh...d.php?t=170781

Microsoft Office
Help

vba to send multiple workbooks to different address
 

Try this

Dim cell As Range
Dim strbody As String
For Each cell In ThisWorkbook.Sheets("Sheet1").Range("A3:A50")
strbody = strbody & cell.Value & vbNewLine
Next


--

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


"jamesc" wrote in message ...
Ron, this works, but it seems like there is only a limit of cells i can do
thhis with. is there no way to grab an actual range of cells, like A3:A50?


"Ron de Bruin" wrote in message
...
See this part in the code

With mybook.Worksheets(1)
strbody = "Hi there" & vbNewLine & vbNewLine &
_
.Range("A1") & vbNewLine & _
.Range("A2") & vbNewLine & _
.Range("A3") & vbNewLine & _
.Range("A4")
End With

Sub Example_3()
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
Dim oApp As Object
Dim oFolder As Variant
Dim strbody As String

Set oApp = CreateObject("Shell.Application")

'Browse to the folder
Set oFolder = oApp.BrowseForFolder(0, "Select folder", 512)
If Not oFolder Is Nothing Then

'Fill in the path\folder where the files are
MyPath = oFolder.Self.Path

'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

With mybook.Worksheets(1)
strbody = "Hi there" & vbNewLine & vbNewLine &
_
.Range("A1") & vbNewLine & _
.Range("A2") & vbNewLine & _
.Range("A3") & vbNewLine & _
.Range("A4")
End With

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 = strbody
.Attachments.Add mybook.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Display 'or use .Display
End With
Set OutMail = Nothing

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 If
End Sub




--

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


"jamesc" wrote in message
...
Not sure if my last post went through or not so i will try again :-)

Ron,
the range is located in each workbook i open and send by email. so the
data could be different in each email body. because i am using a range
from a pivot table, i was hoping that it would only grab actual text and
not all the blank cells in between.

"Ron de Bruin" wrote in message
...
Where is that range

In the workbook with the code

Or in each workbook you open and send by mail

--

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


"jamesc" wrote in message
...
in the body part of your example i would like to add custom text, mixed
with text from the workbook.

example: Hi, you are not able to order the followin products: (range
from a pivot table, ie A3:a100)


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

Are the cells that you want to use in the body string in the workbook
with the code Or do you want to use the cells in the workbooks you
send
So that every mail have a different body string



--

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


"jamesc" wrote in message
...
Worked perfectly!

I really appreciate all your effort! i was able to step through all
the code and make some small changes (customized the subject and body
text). Feel like i'm learning a lot from this! thank you so much!
On your website, is there anywhere that you discuss mixing text with
range data together to appear as text?



"Ron de Bruin" wrote in message
...
Test this one

Sub Example_2()
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
Dim oApp As Object
Dim oFolder As Variant

Set oApp = CreateObject("Shell.Application")

'Browse to the folder
Set oFolder = oApp.BrowseForFolder(0, "Select folder", 512)
If Not oFolder Is Nothing Then

'Fill in the path\folder where the files are
MyPath = oFolder.Self.Path

'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
Set OutMail = Nothing

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

Else
ErrorYes = True
End If

'Close mybook without saving
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 If
End Sub



--

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


"Ron de Bruin" wrote in message
...
Oops

I post a wrong example here
I mixed two newsgroup postings

I post a example for today

--

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


"Ron de Bruin" wrote in message
...
See the second example in the example workbook from my FSO page

Sub RDB_Merge_Data_Browse()
Dim myFiles As Variant
Dim myCountOfFiles As Long
Dim oApp As Object
Dim oFolder As Variant

Set oApp = CreateObject("Shell.Application")

'Browse to the folder
Set oFolder = oApp.BrowseForFolder(0, "Select folder", 512)
If Not oFolder Is Nothing Then

myCountOfFiles = Get_File_Names( _
MyPath:=oFolder.Self.Path, _
Subfolders:=False, _
ExtStr:="*.xl*", _
myReturnedFiles:=myFiles)

If myCountOfFiles = 0 Then
MsgBox "No files that match the ExtStr in this folder"
Exit Sub
End If

Get_Data _
FileNameInA:=True, _
PasteAsValues:=True, _
SourceShName:="", _
SourceShIndex:=1, _
SourceRng:="A1:G1", _
StartCell:="", _
myReturnedFiles:=myFiles

End If

End Sub


--

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


"jamesc" wrote in message
...
hi Joel, how or where do i include this in Ron's code posted
earlier?
"joel" wrote in message
...

I took this example from the VBA help under Filedialog. The
only thing
I changed was from msoFileDialogFilePicker to
msoFileDialogFolderPicker.
the code really calls the dll in the windows system32 folder.
There
are two versions of the DLL and older one that is not size
adjustable
and the new one the is size adjutable. Using the method below
calls the
older version of the dialog. You have to call the DLL directly
to get
the newer version.



Sub Main()

'Declare a variable as a FileDialog object.
Dim fd As FileDialog

'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFolderPicker)

'Declare a variable to contain the path
'of each selected item. Even though the path is a String,
'the variable must be a Variant because For Each...Next
'routines only work with Variants and Objects.
Dim vrtSelectedItem As Variant

'Use a With...End With block to reference the FileDialog object.
With fd

'Use the Show method to display the File Picker dialog box and
return the user's action.
'The user pressed the action button.
If .Show = -1 Then

'Step through each string in the FileDialogSelectedItems
collection.
For Each vrtSelectedItem In .SelectedItems

'vrtSelectedItem is a String that contains the path of
each selected item.
'You can use any file I/O functions that you want to
work with this path.
'This example simply displays the path in a message
box.
MsgBox "The path is: " & vrtSelectedItem

Next vrtSelectedItem
'The user pressed Cancel.
Else
End If
End With

'Set the object variable to Nothing.
Set fd = Nothing

End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread:
http://www.thecodecage.com/forumz/sh...d.php?t=170781

Microsoft Office
Help