如何在将数据从Excel导入Outlook时设置固定列宽？

我编写了一个Excel VBA脚本来生成一个报告，然后通过电子邮件发送。我使用了Ron De Bruin的

RangetoHTML

函数

这些报告是动态的，通常会放置一些手动的东西。执行此操作时，列会自行调整大小

我在Outlook的布局选项卡中看到了一个Autofit（固定列宽）选项，但我正在寻找在宏中引入该选项的方法

函数prepmail（）
调暗r1作为量程
作为变体的dimd
将d2设置为字符串
Dim OutApp作为对象
将邮件变暗为对象
设置r1=无
'仅发送所选内容中的可见单元格。
设置r1=范围（单元格（1，1），单元格（21，3））
如果r1什么都不是，那么
MsgBox“所选内容不是范围或工作表受保护。”&_
vbNewLine&“请更正并重试。”，vbOKOnly
退出功能
如果结束
应用
.EnableEvents=False
.ScreenUpdate=False
以
将s1变暗为字符串
'调用格式化设置程序
变暗r2作为范围
将s2设置为字符串
s1=RangetoHTML（r1）
d=日期-1
单元格（22,3）。值=d
单元格（22,3）.NumberFormat=“mm/dd/yyyy”
d2=VBA.格式（d，“mm/dd/yyyy”）
Set-OutApp=CreateObject（“Outlook.Application”）
Set-OutMail=OutApp.CreateItem（0）
发邮件
.to=“MML RPS”
.CC=“MML团队”
.BCC=“”
.Subject=“RPS批次周期状态报告：”&d2
.HTMLBody=s1
'代替下面的语句，您可以使用“.Display”来
'显示电子邮件消息。
.展示
以
错误转到0
应用
.EnableEvents=True
.ScreenUpdate=True
以
发送邮件=无
设置应用程序=无
端函数
函数RangetoHTML（rng作为范围）
“罗恩·德·布鲁因。
作为对象的Dim fso
将T作为对象
将文件设置为字符串
将TempWB设置为工作簿
Dim vPath作为字符串
vPath=ThisWorkbook.Path
TempFile=vPath&“\”和“temp.htm”
'复制范围并创建一个新工作簿，以超过中的数据
收到
Set TempWB=工作簿。添加（1）
带临时工作表（1）
.单元格（1）.粘贴特殊粘贴：=8
.单元格（1）.粘贴特殊值，False，False
.单元格（1）.粘贴特殊xlPasteFormats，False，False
.单元格（1）。选择
Application.CutCopyMode=False
出错时继续下一步
.DrawingObjects.Visible=True
.DrawingObjects.Delete
错误转到0
以
'将工作表发布到htm文件
使用TempWB.PublishObjects.Add（_
SourceType:=xlSourceRange_
文件名：=临时文件_
工作表：=临时工作表（1）.名称_
来源：=TempWB.Sheets（1）.UsedRange.Address_
HtmlType:=xlHtmlStatic）
.发布（真实）
以
'将htm文件中的所有数据读入RangetoHTML
设置fso=CreateObject（“Scripting.FileSystemObject”）
设置ts=fso.getfile（TempFile）.OpenAsTextStream（1，-2）
RangetoHTML=ts.ReadAll
关闭
RangetoHTML=Replace（RangetoHTML，“align=center x:publishsource=”_
“align=left x:publishsource=”）
“关闭TempWB
TempWB.Close savechanges:=False
'删除此函数中使用的htm文件
杀死临时文件
设置ts=无
设置fso=无
设置TempWB=Nothing
端函数

您需要在复制部分之后复制目标范围内的行的高度和列的宽度：

...
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
...

---

是否需要：您不希望Outlook调整列的大小？那么您想使用Excel VBA执行此操作吗？是的，确切地说，当数据导入outlook，然后在电子邮件中手动进行进一步修改时，列将展开，而不是保持理想的固定宽度。因此，每次我向单元格中添加内容时，我都必须手动按ALT+Enter以避免出现这种情况，或者必须关闭自动调整大小选项。谢谢你，D.O.我尝试过这样做，但问题仍然存在。我不确定，但我猜这段代码会将outlook中的行和列高度设置为与excel中的列和行高度相同。然后，一旦邮件准备好，当一些数据手动输入单元格时，行和列将再次打开自动调整大小，但我不确定。我正在寻找一种方法，在邮件准备好后修复列宽，这样在邮件准备好后手动将数据输入单元格时，列就不会调整大小。