none
Macros/VBA in Word vs Outlook 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

    Wednesday, June 6, 2012 4:22 PM

All replies

  • I would recommend posting your question to the Outlook and/or Word for Developers forums. This forum is primarily for Visual Basic .NET.

    http://social.msdn.microsoft.com/Forums/en/outlookdev/threads

    http://social.msdn.microsoft.com/Forums/en/worddev/threads


    Paul ~~~~ Microsoft MVP (Visual Basic)

    Wednesday, June 6, 2012 5:14 PM
  • Hi Steve99g,

    Thank you for posting in MSDN forum.
    I’m doing research on your issue and the below is progress that have been made so far.

    I’ve picked out the code snippet below and put it into an independent macro.

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

    However I cannot see word.exe in my task manager after I compile the code.  Then I tried to add oWord.Visible = True in your code, but still no Word application been opened.
    Finally, I achieved the goal by using code below.

    Sub test()
        ' 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
         
         If oWord.Visible <> True Then
            oWord.Visible = True
         End If
         
         'open the address file, reformat and copy the text
         Set ODocument = oWord.Documents.Open ("D:\Research\contact list.csv")
         ' I've create my own contact list.csv file.
         ' I can't open csv file by using GetObject() function.
         ' 
    End Sub

    Besides, I want to know how your managercontacts.csv file is formatted. You can create a sample and send a screenshot and some specification.

    As far as I know, csv file can be opened by Excel. Will it be more efficient for you to get address if you open the contact list with Excel?

    I’m looking forward to your reply.

    Best Regards,
    Quist


    Quist Zhang [MSFT]
    MSDN Community Support | Feedback to us

    Thursday, June 7, 2012 9:19 AM
    Moderator
  • Please specify your Outlook version.
     
    If this is for Outlook 2007 or 2010 you don't use an instance of Word.Application. Use Outlook.Application.ActiveInspector.WordEditor to retrieve the Word.Document object.
     
    From there you can use the Word object model. Most things are available, although some things in the Word object model don't work for a WordMail item.

    --
    Ken Slovak
    [MVP-Outlook]
    http://www.slovaktech.com
    Author: Professional Programming Outlook 2007
    "steve99g" <=?utf-8?B?c3RldmU5OWc=?=> wrote in message news:1d514330-d25d-4b93-998d-d64fad0cbc53...

    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


    Ken Slovak MVP - Outlook
    Thursday, June 7, 2012 2:38 PM
    Moderator