2016-10-07 5 views
2

Я подготовил письмо в Excel, которое заполняет информацию из таблицы данных.Экспорт данных из Excel в Outlook

Ячейка A1 до A4 содержит «Привет, надеюсь, что ваши дела идут хорошо» и сообщений .... и т.д ..

A5 до Н10 имеет таблицу с информацией и A11 к A30 имеет содержание электронной почты, как «ищет вперед для вашего ответа ».

Я хочу скопировать только значения для A1: A4 и A11: A30, но хочу, чтобы A5: H10 отображался как таблица.

Этот код от Ron De Bruin.

Мой код ниже пастами все в табличном формате:

Sub Mail() 

Dim rng As Range 
Dim OutApp As Object 
Dim OutMail As Object 

Set rng = Nothing 
On Error Resume Next 
Set rng = ActiveSheet.Range("A1:A24").SpecialCells(xlCellTypeVisible) 
On Error GoTo 0 

If rng Is Nothing Then 
    MsgBox "The selection is not a range or the sheet is protected" & _ 
      vbNewLine & "please correct and try again.", vbOKOnly 
    Exit Sub 
End If 

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

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

On Error Resume Next 
With OutMail 
    .Display 
    .To = "" 
    .CC = "" 
    .BCC = "" 
    .Subject = "" 
    .HTMLBody = RangetoHTML(rng) 
End With 
On Error GoTo 0 

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

Set OutMail = Nothing 
Set OutApp = Nothing 
End Sub 

Мой Остальной код:

Function RangetoHTML(rng As Range) 
Dim fso As Object 
Dim ts As Object 
Dim TempFile As String 
Dim TempWB As Workbook 

TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm" 

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 

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 

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=") 

TempWB.Close savechanges:=False 

Kill TempFile 

Set ts = Nothing 
Set fso = Nothing 
Set TempWB = Nothing 
End Function 
+0

Где остальная часть кода? – 0m3r

+1

Я обновил, как вы просили. – Pranay

ответ

2

Work with shortcut range method[]

Общий метод Range("A1").Value = 123 и Ярлык метод [A1] = 123

Пример

With OutMail 
    .Display 
    .To = "" 
    .CC = "" 
    .BCC = "" 
    .Subject = "" 
    .HTMLBody = [A1] & "<BR>" & _ 
       [A2] & "<BR>" & _ 
       [A3] & "<BR>" & _ 
       [A4] & RangetoHTML(rng) & _ 
       [A11] & "<BR>" & _ 
       [A12] & "<BR>" & _ 
       [A13] & "<BR>" & _ 
       [A14] & "<BR>" 
       ' And more [range] 
End With 

Напомним, что квадратные скобки являются заменой для диапазона/Скобки/Кавычки построения, метод возвращает реальную ссылку диапазон, он может использоваться по обе стороны от знака равенства. Он может использоваться для подачи других функций. Он имеет все методы и свойства нормального диапазона.

Помните Ярлык метод никогда не самый быстрый

Смежные вопросы