3

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
4

1 に答える 1

5

添付ファイルを抽出するためのコードがすでにあるので。次のステップは、ファイルを開き、テキスト全体をコピーして、現在の電子メールに貼り付けることです。

これを試してください（試してテスト済み）

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
于 2012-06-09T04:30:00.620 に答える