所以我试图让它复制另一个列为变量的部分范围' Temp'那么如何让VBA复制excel中的范围Temp并将格式和值粘贴到outlook体中?
Sub OutlookMessage()
Dim OutApp
Dim objOutlookMsg
Dim objOutlookRecip
Dim Recipients
Dim SubjLine As String
Dim MonSubjLine As String
Dim ws As Worksheet
Dim sndRange As Range
Dim Sunday
Dim Monday
Dim Today As Integer
Set OutApp = CreateObject("Outlook.Application")
Set objOutlookMsg = OutApp.CreateItem(olMailItem)
Set Recipients = objOutlookMsg.Recipients
Set objOutlookRecip = Recipients.Add("Recipient")
objOutlookRecip.Type = 1
objOutlookMsg.SentOnBehalfOfName = "Sender"
Today = Weekday(Date, vbMonday)
If Today = 1 Then
Sunday = Date - 1
Monday = Date - 7
End If
MonSubjLine = "WEEK " & (DatePart("ww", Date, vbMonday) - 1) & " - PHONE REPORT (" & Monday & " Th " & Sunday & ")"
SubjLine = StrConv(WeekdayName(Weekday(Date - 1, vbMonday), False, vbMonday), vbUpperCase) & " (" & Date - 1 & ") PHONE REPORT"
Today = Weekday(Date, vbMonday)
If Today > 1 Then
objOutlookMsg.Subject = SubjLine
ElseIf Today = 1 Then
objOutlookMsg.Subject = MonSubjLine
End If
objOutlookMsg.HTMLBody = "How to Get My Table In Here?"
For Each objOutlookRecip In objOutlookMsg.Recipients
objOutlookRecip.Resolve
Next
objOutlookMsg.Display
Set OutApp = Nothing
End Sub
我最终只是用它来粘贴它
SendKeys "^({v})", True
答案 0 :(得分:0)
我强烈建议Ron de Bruin's Site自动将电子邮件从Excel升级到Outlook。例如:
Sub Mail_Range()
'Working in Excel 2000-2013
'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-2013
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
答案 1 :(得分:0)
Outlook对象模型提供了三种身体操作方式。
Chapter 17: Working with Item Bodies深入介绍了所有这些方法。这取决于你选择哪种方式。