.rtf 현재 전자 메일 본문에 첨부 및 붙여 넣기 내용

Question

SendObject 메서드를 사용하여 전자 메일의 첨부 파일로 보고서를 내보내는 Access 데이터베이스가 있습니다.

첨부 파일을 열고 서식있는 텍스트를 복사하여 생성 된 전자 메일 본문에 붙여넣고 파일을 삭제하면됩니다.

첨부 파일을 제거하고 열 수있는 코드가 있지만 Word 문서의 모든 내용을 복사하여 원본 전자 메일에 붙여 넣는 방법을 잘 모르겠습니다.

도움이 될 것입니다. 좀 더 간단한 방법이 있다면 알려주십시오.

Sub olAttachmentStrip() 
    Dim strFilename As String 
    Dim strPath As String 
    Dim olItem As Outlook.MailItem 
    Dim olAtmt As Outlook.Attachments 
    Dim olInspector As Outlook.Inspector 
    Dim appWord As Word.Application 
    Dim docWord As Word.Document 

    strPath = "C:\temp\" 

    Set olInspector = Application.ActiveInspector 
    If Not TypeName(olInspector) = "Nothing" Then 
    If TypeName(olInspector.CurrentItem) = "MailItem" Then 
     Set olItem = olInspector.CurrentItem 
     Set olAtmt = olItem.Attachments 
      olAtmt.Item(1).SaveAsFile strPath & olAtmt.Item(1).DisplayName 
      strFilename = strPath & olAtmt.Item(1).DisplayName 
      'olAtmt.Item(1).Delete 
    Else 
    MsgBox "Something went horribly wrong." 
    End If 
    End If 

    Set appWord = CreateObject("Word.Application") 
    appWord.Visible = False 
    Set docWord = appWord.Documents.Open(strFilename) 
    Stop '<== This is where I'm stuck! 
    Set docWord = Nothing 
    Set appWord = Nothing 
End Sub 

Answer 1

첨부 파일을 추출하는 코드가 이미 있으므로 다음 단계는 파일을 열어 전체 텍스트를 복사하여 현재 이메일에 붙여 넣는 것입니다.

은 ( 이 시도하고 테스트)이 시도 완벽하게 작동,하지만 난 또 하나의 문제가

Option Explicit 

Sub Sample() 
    Dim doc As Object, sel As Object 
    Dim oWord As Object, oDoc As Object, wRng As Object 


    '~~> Establish an EXCEL application object 
    On Error Resume Next 
    Set oWord = GetObject(, "Word.Application") 

    '~~> If not found then create new instance 
    If Err.Number <> 0 Then 
     Set oWord = CreateObject("Word.Application") 
    End If 
    Err.Clear 
    On Error GoTo 0 

    '~~> Open the Attachement 
    Set oDoc = oWord.Documents.Open(FileName:="C:\MyDocument.rtf", ConfirmConversions:=False, _ 
     ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _ 
     PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _ 
     WritePasswordTemplate:="", Format:=0, XMLTransform:="", _ 
     Encoding:=1200) 

    '~~> Get the comeplete text and copy it 
    Set wRng = oDoc.Range 
    wRng.Copy 

    '~~> Close word Doc 
    oDoc.Close 

    '~~> Paste it in active email 
    Set doc = ActiveInspector.WordEditor 
    Set sel = doc.Application.Selection 
    sel.Paste 

    '~~> Clean up 
    Set wRng = Nothing: Set oDoc = Nothing: Set oWord = Nothing 
End Sub