Columns auto fit on outlook mail body
Deat Team,
I am doing copy paste datas from excel to outlook and sending mail.
For that i am using the following code
Code:
Private i As Integer, j As Integer, k As IntegerPrivate LastRow As Integer
Private oItem As Object
Private olInsp As Object
Private wdDoc As Object
Private oRng As Object
Private oTable As Object
Private oColl As Collection
Private vCell As Variant
Private strMessageText As String
Private oOutlookApp As Object
Sub SendEmail()
'Graham Mayor - https://www.gmayor.com - Last updated - 28 Dec 2019
With UserForm1
.Show
If .Tag = 0 Then GoTo lbl_Exit
Set xlsheet = Sheets(1)
Set oColl = New Collection
'Store the table column titles separated by '|'
oColl.Add "Customer Name" & vbTab & vbTab & "|" & "Invoice No" & "|" & "Date" & "|" & "Outstanding Amount" & "|" & _
"Location" & vbTab & vbTab & "|" & "Equipement" & "|" & "Product" & "|" & "M/c S.No" & "|" & "No of days Pending"
With xlsheet
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
'add the required columns to the collection separated by '|'. There should be as many columns as there are titles above
For i = 2 To LastRow
If .Range("J" & i) = UserForm1.ComboBox1.Column(0) Then
oColl.Add .Range("B" & i) & "|" & .AutoFit _
.Range("C" & i) & "|" & _
.Range("D" & i) & "|" & _
.Range("E" & i) & "|" & _
.Range("F" & i) & "|" & _
.Range("G" & i) & "|" & _
.Range("H" & i) & "|" & _
.Range("I" & i) & "|" & _
.Range("K" & i)
End If
Next i
End With
Set oOutlookApp = OutlookApp() 'Uses the function from http://www.rondebruin.nl/win/s1/outlook/openclose.htm
'to open Outlook (ModGetOutlook), or it will not work correctly
'Create a new mailitem
Set oItem = oOutlookApp.CreateItem(0)
With oItem
.BodyFormat = 2 'html
.To = UserForm1.ComboBox1.Column(1)
'Give it a title
.Subject = "Service Payment outstanding details"
.Display
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor 'access the message body for editing
Set oRng = wdDoc.Range
oRng.collapse 1 'set a range to the start of the message
'oRng.Text = "This is the text before the data." & vbCr & vbCr
oRng.Text = "Dear KJ" & vbCr & vbCr & "Pls find the updated outstanding details for your reference" & vbCr & vbCr
'Collapse the range to its end
oRng.collapse 0
'Create a table
k = UBound(Split(oColl(1), "|")) + 1
Set oTable = wdDoc.tables.Add(oRng, oColl.Count, k)
With oTable
For i = 1 To oColl.Count
vCell = Split(oColl(i), "|")
For j = 0 To UBound(vCell)
oTable.Rows(i).Cells(j + 1).Range.Text = vCell(j)
Next j
Next i
.Style = "Table Grid"
End With
oRng.End = oTable.Range.End
'Collapse the range to its end
oRng.collapse 0
oRng.Text = vbCr & "Please collect the above payment as soon as possible." & vbCr
'The range will be followed by the signature associated with the mail account
'.Send
End With
End With
'Clean up
lbl_Exit:
Unload UserForm1
Set oItem = Nothing
Set oOutlookApp = Nothing
Set olInsp = Nothing
Set wdDoc = Nothing
Set oTable = Nothing
Set oColl = Nothing
Set oRng = Nothing
Set xlsheet = Nothing
Exit Sub
End Sub
In this code i want the following to be update in Bold and center
Code:
oColl.Add "Customer Name" & vbTab & vbTab & "|" & "Invoice No" & "|" & "Date" & "|" & "Outstanding Amount" & "|" & _ "Location" & vbTab & vbTab & "|" & "Equipement" & "|" & "Product" & "|" & "M/c S.No" & "|" & "No of days Pending"
and the following to auto fit as per the maximum charecters
Code:
oColl.Add .Range("B" & i) & "|" & .AutoFit _
.Range("C" & i) & "|" & _
.Range("D" & i) & "|" & _
.Range("E" & i) & "|" & _
.Range("F" & i) & "|" & _
.Range("G" & i) & "|" & _
.Range("H" & i) & "|" & _
.Range("I" & i) & "|" & _
.Range("K" & i)
Can any one help me how to align my data,s automatically with code
