Dán dữ liệu dạng Keep Text Ony từ Excel vào Outlook bằng VBA

[MinhKhai]

Chào các anh chị
Hàng ngày em phải gửi email theo định dạng như hình dưới. Em có tạo file và nhập liệu từ Excel rồi dùng VBA để mở sẵn New Message trong Outlook, sau đó Paste thủ công dạng Keep Text Only vào Outlook.
Nhờ các anh chị giúp đỡ code VBA để sao cho khi bấm nút trong Excel, New Message của Outlook mở ra và vùng dữ liệu trong Excel được copy và dán dạng Keep Text Only luôn vào.
Xin cảm ơn các anh chị !

 

[MinhKhai]

Vấn đề này chẳng lẽ VBA Excel không đẩy dữ liệu copy được sang MS Outlook ?

 

[BuiQuangThuan]

Vấn đề này chẳng lẽ VBA Excel không đẩy dữ liệu copy được sang MS Outlook ?

Dán theo kiểu này được không ta?Hay phải nhấtđịnh là chỉđược dán chữ thôi

 

[MinhKhai]

Dán theo kiểu này được không ta?View attachment 297080Hay phải nhấtđịnh là chỉđược dán chữ thôi

Dạ không bác ơi. Cái mẫu này phải theo chuẩn chung rồi.

 

[huhumalu]

Private Sub CmdOpenOutlook_Click()

    Application.ScreenUpdating = False

    'Sort theo UT
    Worksheets("LGH").Sort.SortFields.Clear
    Range("D10:I17").Sort Key1:=Range("H10"), Order1:=xlAscending, Header:=xlNo
    Sheet11.Range("D10:D18").SpecialCells(4).EntireRow.Hidden = True
    CmdFCShow.Caption = "Show All Rows"

    'Dulieu
    Dim TempRange As Range
    Set TempRange = Sheet11.Range("D9:I19").SpecialCells(xlCellTypeVisible)
    'Copy TempRange vào clipboard
    TempRange.Copy

    'Mo Outlook
    Dim ObjMail As Object
    Set ObjMail = CreateObject("Outlook.Application").CreateItem(0)

    'Paste Keep Text Only
    With ObjMail.GetInspector.WordEditor.Range
        .PasteSpecial DataType:=wdPasteText
    End With

    With ObjMail
        .To = "test@gmail.com"
        .Subject = Sheet11.[F4]
        .Importance = 2
        .Display
    End With

    Set TempRange = Nothing
    Set ObjMail = Nothing

    Application.ScreenUpdating = True

End Sub

Bạn xem thử. Trong Reference bạn chọn

 

[befaint]

Gì mà kíp tếch ôn ly. Vờ bờ táp thôi mà.



Chép cho dẻo tay ha.

 

[MinhKhai]

Private Sub CmdOpenOutlook_Click()

    Application.ScreenUpdating = False

    'Sort theo UT
    Worksheets("LGH").Sort.SortFields.Clear
    Range("D10:I17").Sort Key1:=Range("H10"), Order1:=xlAscending, Header:=xlNo
    Sheet11.Range("D10:D18").SpecialCells(4).EntireRow.Hidden = True
    CmdFCShow.Caption = "Show All Rows"

    'Dulieu
    Dim TempRange As Range
    Set TempRange = Sheet11.Range("D9:I19").SpecialCells(xlCellTypeVisible)
    'Copy TempRange vào clipboard
    TempRange.Copy

    'Mo Outlook
    Dim ObjMail As Object
    Set ObjMail = CreateObject("Outlook.Application").CreateItem(0)

    'Paste Keep Text Only
    With ObjMail.GetInspector.WordEditor.Range
        .PasteSpecial DataType:=wdPasteText
    End With

    With ObjMail
        .To = "test@gmail.com"
        .Subject = Sheet11.[F4]
        .Importance = 2
        .Display
    End With

    Set TempRange = Nothing
    Set ObjMail = Nothing

    Application.ScreenUpdating = True

End Sub

Bạn xem thử. Trong Reference bạn chọn
View attachment 297081

Bác ơi, em test nó chạy như mong muốn rồi. Có 1 vấn đề này mong bác xử lý nốt giúp, đó là làm sao để nối cái Signature mặc định trong Outlook vào nội dung này. Cảm ơn bác

 

[MinhKhai]

Gì mà kíp tếch ôn ly. Vờ bờ táp thôi mà.

View attachment 297082

Chép cho dẻo tay ha.

View attachment 297083

Em gõ sai cái gì mà nó báo đỏ bác nhỉ ? Bác chỉ giúp với nhé