none
outlook vba code to automate word RRS feed

  • Question

  • I created a macro in Word that would find a paragraph mark (^p) and replace with a semi-colon (;) in a 10 iteration loop, then copy the next from the top of the document to the last character before the next (11th) paragraph mark. When the macro runs, the immediate window shows that the Selection.Text property holds the text with the semi-colons inserted for paragraph marks.

    When I ported the code to Outlook VBA (and change the code to reference the Word object model), the code runs through completion, but the Application.ActiveWindow.Selection.Text returns the first letter in the document (or the first letter after the selected text.

    Why am I losing the selected text when I run this through Outlook? The code is below:


    Sub MakeItem()
           
    ' create the email & attach the press release
        Set newItem = Application.CreateItemFromTemplate("c:\users\steve\appdata\roaming\microsoft\templates\press release - mesa investment consulting.oft")
        newItem.Attachments.Add "C:\Users\Steve\Documents\MESA\Press Release\MESA Press Resease - FINAL 6-5-12.pdf"
       
    ' open word
        On Error Resume Next
        fSuccess = True
       
        Set oWord = GetObject("Word.Application")
        If Err.Number > 0 Then
            Err.Clear
            Set oWord = CreateObject("word.application")
            If Err.Number > 0 Then
                MsgBox "Could not open Word", vbCritical
                fSuccess = False
                Exit Sub
            End If
        End If
           
    ' open the address file, reformat and copy the text
        Set ODocument = GetObject("c:\users\steve\documents\mesa\press release\distribution 6-5-2012\managercontacts - working.csv")
        With oWord
        Dim i As Integer
       
        .Selection.Find.ClearFormatting
        .Selection.Find.Replacement.ClearFormatting
        With .Selection.Find
            .Text = "^p"
            .Replacement.Text = ";"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        .Selection.Find.Execute
        With .Selection
            If .Find.Forward = True Then
                .Collapse Direction:=wdCollapseStart
            Else
                .Collapse Direction:=wdCollapseEnd
            End If
            .Find.Execute Replace:=wdReplaceOne
            If .Find.Forward = True Then
                .Collapse Direction:=wdCollapseEnd
            Else
                .Collapse Direction:=wdCollapseStart
            End If
            .Find.Execute
        End With
       
        For i = 1 To 10
            With .Selection
                If .Find.Forward = True Then
                    .Collapse Direction:=wdCollapseStart
                Else
                    .Collapse Direction:=wdCollapseEnd
                End If
                .Find.Execute Replace:=wdReplaceOne
                If .Find.Forward = True Then
                    .Collapse Direction:=wdCollapseEnd
                Else
                    .Collapse Direction:=wdCollapseStart
                End If
                .Find.Execute
            End With
        Next i
       
        .Selection.HomeKey Unit:=wdStory
        .Selection.Find.ClearFormatting
       
        With .Selection.Find
            .Text = "^p"
            .Replacement.Text = ";"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        .Selection.Find.Execute
        .Selection.HomeKey Unit:=wdStory, Extend:=wdExtend
        .Selection.Copy
        MsgBox .Selection.Text


        End With
       
        newItem.BCC = ODocument.ActiveWindow.Selection.Text
       
        ODocument.ActiveWindow.Selection.Cut
        ODocument.ActiveWindow.Selection.Delete Unit:=wdCharacter, Count:=1
       
        newItem.Display
        Set newItem = Nothing

    End Sub


    steve

    Wednesday, June 6, 2012 5:54 PM

All replies

  • I created a macro in Word that would find a paragraph mark (^p) and replace with a semi-colon (;) in a 10 iteration loop, then copy the next from the top of the document to the last character before the next (11th) paragraph mark. When the macro runs, the immediate window shows that the Selection.Text property holds the text with the semi-colons inserted for paragraph marks.

    When I ported the code to Outlook VBA (and change the code to reference the Word object model), the code runs through completion, but the Application.ActiveWindow.Selection.Text returns the first letter in the document (or the first letter after the selected text.

    Why am I losing the selected text when I run this through Outlook? The code is below:


    Sub MakeItem()
           
    ' create the email & attach the press release
        Set newItem = Application.CreateItemFromTemplate("c:\users\steve\appdata\roaming\microsoft\templates\press release - mesa investment consulting.oft")
        newItem.Attachments.Add "C:\Users\Steve\Documents\MESA\Press Release\MESA Press Resease - FINAL 6-5-12.pdf"
       
    ' open word
        On Error Resume Next
        fSuccess = True
       
        Set oWord = GetObject("Word.Application")
        If Err.Number > 0 Then
            Err.Clear
            Set oWord = CreateObject("word.application")
            If Err.Number > 0 Then
                MsgBox "Could not open Word", vbCritical
                fSuccess = False
                Exit Sub
            End If
        End If
           
    ' open the address file, reformat and copy the text
        Set ODocument = GetObject("c:\users\steve\documents\mesa\press release\distribution 6-5-2012\managercontacts - working.csv")
        With oWord
        Dim i As Integer
       
        .Selection.Find.ClearFormatting
        .Selection.Find.Replacement.ClearFormatting
        With .Selection.Find
            .Text = "^p"
            .Replacement.Text = ";"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        .Selection.Find.Execute
        With .Selection
            If .Find.Forward = True Then
                .Collapse Direction:=wdCollapseStart
            Else
                .Collapse Direction:=wdCollapseEnd
            End If
            .Find.Execute Replace:=wdReplaceOne
            If .Find.Forward = True Then
                .Collapse Direction:=wdCollapseEnd
            Else
                .Collapse Direction:=wdCollapseStart
            End If
            .Find.Execute
        End With
       
        For i = 1 To 10
            With .Selection
                If .Find.Forward = True Then
                    .Collapse Direction:=wdCollapseStart
                Else
                    .Collapse Direction:=wdCollapseEnd
                End If
                .Find.Execute Replace:=wdReplaceOne
                If .Find.Forward = True Then
                    .Collapse Direction:=wdCollapseEnd
                Else
                    .Collapse Direction:=wdCollapseStart
                End If
                .Find.Execute
            End With
        Next i
       
        .Selection.HomeKey Unit:=wdStory
        .Selection.Find.ClearFormatting
       
        With .Selection.Find
            .Text = "^p"
            .Replacement.Text = ";"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        .Selection.Find.Execute
        .Selection.HomeKey Unit:=wdStory, Extend:=wdExtend
        .Selection.Copy
        MsgBox .Selection.Text


        End With
       
        newItem.BCC = ODocument.ActiveWindow.Selection.Text
       
        ODocument.ActiveWindow.Selection.Cut
        ODocument.ActiveWindow.Selection.Delete Unit:=wdCharacter, Count:=1
       
        newItem.Display
        Set newItem = Nothing

    End Sub


    steve

    Wednesday, June 6, 2012 5:56 PM
  • what exactly do you want to achieve with outlook? if you want to manipulate mail's body using word API , open up mail using

    newItem.Display

    and then obtain reference to word Document object using

    newItem.GetInspector.WordEditor

    and now you can change mail's body.

    If however you want to simply open up word besides outlook then it should work. Where exactly do you see diffrerence with outlook running?

    Wednesday, June 6, 2012 6:20 PM
  • from within Outlook, I'm trying to create a new mail item from a template (that works), attach a file (that works), then open a csv file in word that contains email address, then 10 at a time, replace the paragraph mark with a semicolon, select the 10 addresses and paste them into the BCC field of the mail item.

    when I run the code in word, the .Selection.Text property holds the email addresses after the .Selection.Find.Execute statement. when I run the same code from the Outlook macro, the .Selection.Text property holds either a) the first letter of the selected text or b) the first letter after the selected text. It's hard to tell since I can't see what's happening in the word document when I'm in Outlook (whereas from Word, you see the impact of each statement in the macro).


    steve

    Wednesday, June 6, 2012 7:21 PM
  • if this is real csv file,, wouldn't it be easier to just manipualte it using FSO and string functions?
    Wednesday, June 6, 2012 7:53 PM