theHydra
03-24-2018, 03:57 PM
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
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