Mail Range or Selection

kripper

Board Regular
Joined
Dec 16, 2013
Messages
102
Good Afternoon Excel Guru's.....

I am having a bit of an issue trying to make a macro created by Ron de Bruin work for me as I want it to, and I was hoping someone may have tried to reconfigure to do the same or would know how to configure it.

Basically I am using the script from Ron's site http://www.rondebruin.nl/win/s1/outlook/amail4.htm, and it works great, however, I am looking for a way to have the columns sized to the width I would like them to be when it creates the email.

Currently, it does not word wrap, and makes some columns extremely large, where others are very small.

I have spent the last several hours trying many different suggestions via web searches, by to no avail.

This Ron's code, exactly what I am using, except for the modifications of the email recipient, priority, etc.
Sub Mail_Range()'Working in Excel 2000-2016
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm

Dim Source As Range
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object

Set Source = Nothing
On Error Resume Next
Set Source = Range("A1:K50").SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If Source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
Exit Sub
End If

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set wb = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)

Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With

TempFilePath = Environ$("temp") & ""
TempFileName = "Selection of " & wb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2016
FileExtStr = ".xlsx": FileFormatNum = 51
End If

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.to = "ron@debruin.nl"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add Dest.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")

.Send 'or use .Display
End With
On Error GoTo 0
.Close savechanges:=False
End With

Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With End Sub

Hoping someone can assist me to get the columns to size as I need them to, not pre-formatted by excel or outlook.

Thanks
K.
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
Just some clarification, are you wanting to format the columns in the xlsx attachment? Or are you trying to embed the table into the message itself?
 
Upvote 0
Just some clarification, are you wanting to format the columns in the xlsx attachment? Or are you trying to embed the table into the message itself?

I am trying to embed the table into the message body, and when I do, I end up with each column at varying widths, and I am want to set teach column in the message at a specific width so as standardize the look and overall message.
 
Upvote 0
Hi this is a pretty easy fix as long as your using a button to sent the emails simply use this code

Code:
Dim xlRng As Range   'Auto fit to cell
        Dim strCol1 As String ' add further columns as needed
        Dim strCol2 As String
        Dim strCol3 As String
        Dim strCol4 As String
        Dim strRange As String
        strCol1 = "A"
        strCol2 = "B"
        strCol2 = "C"
        strCol2 = "D"
then use Call macro from a module the macro is placed in e.g.

Code:
Call Send_Row_Or_Rows_2() ' macro name

Hope this helps Paul
 
Last edited:
Upvote 0
Hi this is a pretty easy fix as long as your using a button to sent the emails simply use this code

Code:
Dim xlRng As Range   'Auto fit to cell
        Dim strCol1 As String ' add further columns as needed
        Dim strCol2 As String
        Dim strCol3 As String
        Dim strCol4 As String
        Dim strRange As String
        strCol1 = "A"
        strCol2 = "B"
        strCol2 = "C"
        strCol2 = "D"
then use Call macro from a module the macro is placed in e.g.

Code:
Call Send_Row_Or_Rows_2() ' macro name

Hope this helps Paul

Thanks for the reply Paul, however, tried it multiple ways, and without any success, columns within the email body still auto adjust to header title without word wrapping, making some columns 1" and others 6" to 10".
 
Upvote 0
Hi

I had a mess around and came up with this
Code:
Private Sub CommandButton1_Click()


        
        Dim xlRng As Range   'Auto fit to cell
        Dim strCol1 As String
        Dim strCol2 As String
        Dim strCol3 As String
        Dim strCol4 As String
        Dim strRange As String
        strCol1 = "A"
        strCol2 = "B"
        strCol2 = "C"
        strCol2 = "D"
        strRange = strCol1 & ":" & strCol2
        Set xlRng = ActiveSheet.Columns(strRange)
        xlRng.AutoFit
        'Save
        Application.DisplayAlerts = False
        ActiveWorkbook.Save

    

Dim Source As Range
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object

Set Source = Nothing
On Error Resume Next
Set Source = Range("A1:K50").SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If Source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
Exit Sub
End If

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set wb = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)

Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With

TempFilePath = Environ$("temp") & ""
TempFileName = "Selection of " & wb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2016
FileExtStr = ".xlsx": FileFormatNum = 51
End If

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.to = "ron@debruin.nl"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add Dest.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Display 'or use .Send
End With
On Error GoTo 0
.Close savechanges:=False
End With

Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

hope its what your looking for

Paul
 
Upvote 0

Forum statistics

Threads
1,223,903
Messages
6,175,286
Members
452,631
Latest member
a_potato

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top