How to set a Fixed Column Width while importing data from Excel to Outlook?

Question

I wrote an Excel VBA script to generate a reports which were then to be emailed. I used Ron De Bruin's RangetoHTML function.

These reports are dynamic and often a couple of manual things are placed there. On doing so, the columns resize themselves.

I observed an Autofit (Fixed column Width) option in the layout tab of Outlook, but I am looking for ways to introduce this in the macro.

Function prepmail()
    Dim r1 As Range
    Dim d As Variant
    Dim d2 As String
    Dim OutApp As Object
    Dim OutMail As Object
    
    Set r1 = Nothing
    ' Only send the visible cells in the selection.
    
    Set r1 = Range(Cells(1, 1), Cells(21, 3))
    
    If r1 Is Nothing Then
        MsgBox "The selection is not a range or the sheet is protected. " & _
               vbNewLine & "Please correct and try again.", vbOKOnly
        Exit Function
    End If
    
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    Dim s1 As String
    
    'Call formatsetter
    Dim r2 As Range
    Dim s2 As String
    s1 = RangetoHTML(r1)
    
    
    d = Date - 1
    Cells(22, 3).Value = d
    Cells(22, 3).NumberFormat = "mm/dd/yyyy"
    d2 = VBA.format(d, "mm/dd/yyyy")
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .to = "MML RPS <MML_RPS@csc.com>"
        .CC = "MML Team <MML_Team@csc.com>"
        .BCC = ""
        .Subject = "RPS Batch Cycle Status Report: " & d2
        .HTMLBody = s1
        ' In place of the following statement, you can use ".Display" to
        ' display the e-mail message.
        .Display
    End With
    On Error GoTo 0
    
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    
    Set OutMail = Nothing
    Set OutApp = Nothing
End Function
    
Function RangetoHTML(rng As Range)
    ' By Ron de Bruin.
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
    Dim vPath As String
    vPath = ThisWorkbook.Path
    
    TempFile = vPath & "\" & "temp.htm"
    
    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
    
    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
       SourceType:=xlSourceRange, _
       Filename:=TempFile, _
       Sheet:=TempWB.Sheets(1).Name, _
       Source:=TempWB.Sheets(1).UsedRange.Address, _
       HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
    
    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.getfile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
    
    'Close TempWB
    TempWB.Close savechanges:=False
    
    'Delete the htm file we used in this function
    Kill TempFile
    
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

is your need : you don't want Outlook resize the columns? Then you want do it with Excel VBA? — D. O., May 05 '17 at 14:55
Yes exactly, when the data is imported to outlook and then further modifications are done in the email manually, the columns instead of remaining the fixed width they ideally should expands. So every time I am adding something to the cells, I have to either manually press ALT+Enter to avoid so or have to turn off the auto sizing option. — Anton Wilde, May 06 '17 at 00:22

score 1 · Answer 1 · answered May 05 '17 at 15:39

You need to copy the height of the rows and the widths of the columns in the destination range after the copy part :

...
rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    Dim r3 As Range, rw As Integer, c As Integer
    Set r3 = Range(Cells(1, 1), Cells(21, 3))

    With r3
        For rw = 1 To .Rows.Count
            .Rows(rw).RowHeight = rng.Rows(rw).RowHeight
        Next rw
        For c = 1 To .Columns.Count
            .Columns(c).ColumnWidth = rng.Columns(c).ColumnWidth
        Next c
    End With
...

Thank you D.O,I tried this, but still the issue persists.I am not sure but I guess this code would set the row and column height in outlook the same as the row and column height in the column in excel. Then once, the mail is prepared, the rows and columns are again open to auto sizing when some data is entered into the cells manually, I am not sure though. I am looking for some way to fix the column width once the mail is prepared, so that when data is manually entered into the cells after the mail is ready, the columns doesn't resize. — Anton Wilde, May 06 '17 at 00:45

How to set a Fixed Column Width while importing data from Excel to Outlook?

1 Answers1