Quote Originally Posted by gmaxey
To be honest, I was seriously considering ignoring this thead due to lack of cooperation on your part. However the challenge was interesting so I stuck with it.

Here are some things that you should consider before posting again.

1. Answer the questions ask. Doing so may help you discover and resolve the confusion that peoople trying to help you are experiencing. Stamping your foot and endlessly repeating your same question does not help.

2. Provide helpful attachements. Sending a file with two .jpg images and three .png images with code to rename all as .png is not helpful.

3. Declare you're varialbes. I do, and I think most regulars here do, and getting your code with a bunch of undeclared variables is frustrating.

[vba]Sub SaveImage()
Dim strFullName As String, strFileName As String
Dim strBasePath As String, strDate As String
Dim strFolderName As String, strImageName As String
Dim x As Long
Dim oRng As Word.Range
Dim arrCaptions() As String
Dim strExt As String

ReDim arrCaptions(ActiveDocument.InlineShapes.Count - 1)
For x = 1 To ActiveDocument.InlineShapes.Count
Set oRng = ActiveDocument.InlineShapes(x).Range
oRng.Collapse wdCollapseEnd
oRng.MoveEndUntil Cset:="Screen", Count:=wdForward
oRng.Collapse wdCollapseEnd
oRng.MoveEndUntil Cset:=Chr(13), Count:=wdForward
arrCaptions(x - 1) = oRng.Text
Next x

strFullName = ActiveDocument.FullName
strFileName = Left(ActiveDocument.Name, Len(ActiveDocument.Name) - 5)
strBasePath = "C:\Users\Mohit\Desktop\"
strDate = Format(Now, "yyyy-mm-dd")
strFolderName = strDate & "_" & strFileName
'Delete the folder if it exists
On Error Resume Next
Kill strBasePath & strFolderName & "_files\*" 'Delete all files
RmDir strBasePath & strFolderName & "_files" 'Delete folder
On Error GoTo 0
'Save the current document.
ActiveDocument.Save
'Save in HTML format
ActiveDocument.SaveAs2 FileName:=strBasePath & strFolderName & ".html", FileFormat:=wdFormatHTML
ActiveDocument.Close
On Error Resume Next
Kill strBasePath & strFolderName & ".html"
Kill strBasePath & strFolderName & "_files\*.xml"
Kill strBasePath & strFolderName & "_files\*.html"
Kill strBasePath & strFolderName & "_files\*.thmx"
On Error GoTo 0
'Rename image Files
On Error GoTo Err_Ext
For x = 0 To UBound(arrCaptions)
strImageName = Replace(arrCaptions(x), ":", "-")
strExt = ".png"
Name strBasePath & strFolderName & "_files\image00" _
& x + 1 & strExt As strBasePath & strFolderName & "_files\" _
& strFileName & strImageName & strExt
Next
Word.Documents.Open (strFullName)
Word.Application.Visible = True
Word.Application.Activate
Exit Sub
Err_Ext:
strExt = ".jpg"
Resume
End Sub[/vba]

Greg,

Will take care of your points in future.

While running your code, it went for endless loop.

While debuuging the code i came to know that control is not able to come out from loop between below code
Name strBasePath & strFolderName & "_files\image00" _
& x + 1 & strExt As strBasePath & strFolderName & "_files\" _
& strFileName & strImageName & strExt
Next

AND

Err_Ext:
strExt = ".png"
Resume


Can you check once. Did you got my original question or shall i explain again???