Replace-Image-in-Document-Header

[theHydra]

I hope someone is still watching this thread.

This script is exactly what I need but I'm having problems getting it to make changes. It runs and I see the files being opened but it doesn't replace the file. it actually did work on one, but not others, so I suspect there is something with the header.

Any help is GREATLY needed and appreciated.

Here's the code if it matters:

Sub Pic()
Dim strFile As String
Dim oRng As Range
Const strPath As String = "C:\Users\Joshua\OneDrive\Desktop\EHS 4\" '"C:\PMRHeader\PMR\"
Const strNewImage As String = "C:\Users\Joshua\Pictures\PDI.png" '"C:\PMRHeader\Repso1.jpg"
  
  strFile = Dir$(strPath & "*.doc*")
  Do While strFile <> ""
    Application.Documents.Open strPath & strFile
    If ActiveDocument.StoryRanges(wdPrimaryHeaderStory).ShapeRange.Count = 2 Then
      Set oRng = ActiveDocument.StoryRanges(wdPrimaryHeaderStory).ShapeRange.Item(2).Anchor
      ActiveDocument.StoryRanges(wdPrimaryHeaderStory).ShapeRange.Item(2).Delete
      oRng.InlineShapes.AddPicture strNewImage
      If ActiveDocument.Saved = False Then ActiveDocument.Save
     End If
     ActiveDocument.Close
    strFile = Dir$
  Loop
lbl_Exit:
  Exit Sub
End Sub

[SamT]

Moved From http://www.vbaexpress.com/forum/showthread.php?56773

[macropod]

The macro you've posted is for processing floating shapes; it won't work with inlineshapes. What shape format(s) are you working with?