Sub Savepic_Test1()
    Dim sFileName As String
    Dim sBookName As String
    Dim sPath As String
    Dim sFileFilter As String
    Dim a() As String
    Dim cnt As Long
    Dim cnt2 As Long
    Dim sTmpFile As String
    Dim sTmpFolder As String
    Dim vTypes As Variant
    Dim vType As Variant
    Dim sType As String
    Dim i As Long

    sPath = "C:\My Documents\"
    sFileFilter = "test*.xls"

    vTypes = Array("jpg", "gif", "png", "emz", "wmz")

    sFileName = Dir(sPath & sFileFilter)
    Do Until sFileName = ""
        cnt = cnt + 1
        ReDim Preserve a(1 To cnt)
        a(cnt) = sFileName
        sFileName = Dir()
    Loop

    sTmpFile = sPath & "tmp.htm"
    sTmpFolder = sPath & "tmp.files\"

    For i = 1 To cnt
        If Dir(sTmpFile) <> "" Then Kill sTmpFile
        If Dir(sTmpFolder & "*.*") <> "" Then Kill sTmpFolder & "*.*"
        If Dir(sTmpFolder, vbDirectory) <> "" Then RmDir sTmpFolder
        With Workbooks.Open(sPath & a(i))
            .DisplayDrawingObjects = xlHide
            Application.DisplayAlerts = False
            .SaveAs sTmpFile, xlHtml
            Application.DisplayAlerts = True
            .Close False
        End With
        sBookName = a(i)
        If (sBookName Like "*.xls") Then sBookName = Left(sBookName, Len(sBookName) - 4)
        sBookName = sBookName & "_"
        cnt2 = 0
        For Each vType In vTypes
            sFileName = Dir(sTmpFolder & "*." & vType)
            Do Until sFileName = ""
                cnt2 = cnt2 + 1
                sType = vType
                'If vType = "emz" Then sType = "emf.gz"
                'If vType = "wmz" Then sType = "wmf.gz"
                FileCopy sTmpFolder & sFileName, sPath & sBookName & Format(cnt2, "000.") & sType
                sFileName = Dir()
            Loop
        Next
    Next
    If Dir(sTmpFile) <> "" Then Kill sTmpFile
    If Dir(sTmpFolder & "*.*") <> "" Then Kill sTmpFolder & "*.*"
    If Dir(sTmpFolder, vbDirectory) <> "" Then RmDir sTmpFolder

    'ChDrive sPath
    'ChDir sPath
    'Shell "gzip -df *.emf.gz"
    'Shell "gzip -df *.wmf.gz"

End Sub