hello all..

Below code will generate a folder at the file's location, named by [filename]_Pictures with sub folders are named by sheet name inside, inside each subfolder is all pictures on the sheet.
Code:
Sub ExtractPictures()
Dim FSO As Object, sFolder As String, sTmpFolder As String, WB As Workbook, WS As Worksheet, i As Long
Set FSO = VBA.CreateObject("Scripting.FileSystemObject")
Set WB = ActiveWorkbook
sFolder = WB.Path & "\" & WB.Name & "_Pictures"
sTmpFolder = sFolder & "\TmpFolder"
If FSO.FolderExists(sFolder) Then
    FSO.DeleteFolder sFolder
End If
FSO.CreateFolder sFolder
FSO.CreateFolder sTmpFolder
Application.ScreenUpdating = False
For Each WS In WB.Worksheets
    If WS.Pictures.Count > 0 Then
        WS.Copy
        i = i + 1
        ActiveWorkbook.SaveAs Filename:=sTmpFolder & "\s" & i & ".htm", FileFormat:=xlHtml
        FSO.CreateFolder sFolder & "\" & WS.Name
        FSO.CopyFile sTmpFolder & "\s" & i & "_files\*.png", sFolder & "\" & WS.Name
        ActiveWorkbook.Close False
    End If
Next
Application.ScreenUpdating = True
FSO.DeleteFolder sTmpFolder
Shell "Explorer.exe /Open,""" & sFolder & """", 1
End Sub
this macro working not properly..after run macro code , picture automatic create 1 duplicate for each sheet..i don't want that..
for example..i have several sheets e.g. 5 sheets and every one sheet contains 3 picture so total pictures in 5 sheets = 15.
after run macro code above, total picture success exported is 30 that is overload, should be keep 15.

attachment sample file : https://app.box.com/s/od326p56jhau0qe0fx0kxuggg8j6gd5m

across post from https://www.mrexcel.com/board/thread...icate.1138824/

any body would help me, how to solve or modify that code

sst.