VBA find/replace code .Execute Replace:=wdReplaceAll is not working-CodePudding

I am working on export Outlook email able date to excel sheet. But encountered .Execute Replace:=wdReplaceAll error. I have enabled necessary library(see pictures).
enter image description here
enter image description here
enter image description here
enter image description here

Sub CommandButtonS_click()  'Declare outlook variables
    Dim oLookInspector As Inspector
    Dim oLookMailitem As MailItem 'Declare excel variables
    Dim xExcelApp As Excel.Application
    Dim xWb As Excel.Workbook
    Dim xWs As Excel.Worksheet 'Declare word variables
    Dim Wordapp As Word.Application
    Dim oLookWordDoc As Word.document
    Dim oLookwordTbl As Word.Table
    Dim iRow As Long 'row index

    'Grab the mail item
    Set oLookMailitem = Application.ActiveExplorer.CurrentFolder.Items("testing")
    'Grab the active inspector
    Set oLookInspector = oLookMailitem.GetInspector
    'Grab the word editor Object,this returns the word objet model.
    Set oLookWordDoc = oLookInspector.WordEditor
    Dim mypath As String
    mypath = "C:\Users\zhayang\OneDrive - KLA Corporation\Desktop\Master.xlsm"
    'Grab the word table
    Set oLookwordTbl = oLookWordDoc.Tables(1)
    With oLookwordTbl.Range.Find
        .Text = "^p"
        .Replacement.Text = " "
        .Forward = True
        .wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute Replace:=wdReplaceAll
    End With
    
    'rows 2 - end
    For iRow = 2 To oLookwordTbl.Rows.Count
        oLookwordTbl.Rows(iRow).Range.Copy
        'Paste
        xWs.Paste
        xWs.Cells(xWs.Rows.Count, 1).End(3).Offset(1).Select
    Next
End Sub

CodePudding user response：

Try to unprotect mail message before editing (answer https://stackoverflow.com/a/23875246/14907151)

...
Set oLookWordDoc = oLookInspector.WordEditor
oLookWordDoc.UnProtect
...

CodePudding user response：

Problem resolved with below code

 Set xExcelApp = CreateObject("Excel.Application")
Set xWb = xExcelApp.Workbooks.Open(mypath)
xExcelApp.Visible = True
Set xWs = xWb.Sheets("Sheet1")
 xWs.Activate
Set oLookwordTbl = oLookWordDoc.Tables(1)    'Grab the word table
colcount = oLookwordTbl.Columns.Count
For iRow = 2 To oLookwordTbl.Rows.Count         
 'oLookwordTbl.Rows(iRow).Range.Copy
    For icol = 1 To colcount
        cellvalue = oLookwordTbl.Cell(iRow, icol)
        cellvalue = Replace(cellvalue, Chr(13), "")
        cellvalue = Replace(cellvalue, Chr(10), "")
        cellvalue = Replace(cellvalue, Chr(244), "")
        cellvalue = Replace(cellvalue, "^p", "")
        cellvalue = Left(cellvalue, Len(cellvalue) - 1)
        xWs.Cells(iRow, icol).Value = cellvalue
    Next
Next
xWs.Cells(xWs.Rows.Count, 1).End(3).Offset(1).Select
End Sub