How to export a worksheet objust to a folder?

Sub AttachFile()
    Dim fn
    fn = Application.GetOpenFilename("All Files,*.*", Title:=" Find file to insert")
    If FileLen(fn) > 2000000 Then
        MsgBox "File exceeds size limit of 2MB, please choose a smaller file!"
        GoTo TheEnd
    End If
    If fn = False Then
        MsgBox "No file has been selected, please try again!"
    Else
        Sheets("Log File").Select
        ActiveSheet.OLEObjects.Add FileName:=fn, Link:=False, DisplayAsIcon:=True, IconFileName:=fn, IconIndex:=9, IconLabel:=fn, Left:=50, Top:=5, Width:=50, Height:=40
        Sheets("Workflow-Offering Detail").Select
        Sheets("Workflow-Offering Detail").Unprotect
        Range("OffAttach").Value = fn
        Sheets("Workflow-Offering Detail").Protect
        Range("A8").Select
    End If
TheEnd:
End Sub
 
Sub AttachImage()
    Dim vFile As Variant
    vFile = Application.GetOpenFilename("All Files,*.*", Title:=" Find file to insert")
    If FileLen(vFile) > 2000000 Then
        MsgBox "File exceeds size limit of 2MB, please choose a smaller file!"
        GoTo TheEnd
    End If
    If LCase(vFile) = "false" Then
        MsgBox "No file has been selected, please try again!"
    Else
        Sheets("Log File").Select
        ActiveSheet.OLEObjects.Add FileName:=vFile, Link:=False, DisplayAsIcon:=True, IconIndex:=9, IconFileName:=vFile, IconLabel:=vFile, Left:=250, Top:=5, Width:=100, Height:=30
        Sheets("Workflow-Offering Detail").Select
        Sheets("Workflow-Offering Detail").Unprotect
        Range("OffImage").Value = vFile
        Sheets("Workflow-Offering Detail").Protect
        Range("A8").Select
    End If
TheEnd:
End Sub

                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:

Sub SaveEmbeddedFiles()
    
    Dim wkB As Workbook
    Dim wksLog As Worksheet
    Dim wksDetail As Worksheet
    
    Dim sArchivePath As String
    Dim sFullFileName As String
    Dim sFileName As String
    Dim iPos As Integer
    
    Dim oOLE As OLEObject
    Dim wordDoc As Word.Document
    
    sArchivePath = "C:\ArchiveAttachments\"
 
    Set wkB = ActiveWorkbook
    Set wksLog = wkB.Worksheets("Log File")
    Set wksDetail = wkB.Worksheets("Workflow-Offering Detail")
    
    For Each oOLE In wksLog.OLEObjects
        Debug.Print oOLE.progID
        
        If LCase(Left(oOLE.progID, 4)) = "word" Then
            sFullFileName = wksDetail.Range("OffAttach").Value
            iPos = InStrRev(sFullFileName, "\", -1, vbTextCompare)
            sFileName = Right(sFullFileName, Len(sFullFileName) - iPos)
            
            oOLE.Activate
            Set wordDoc = oOLE.Object
            wordDoc.SaveAs sArchivePath & sFileName
            wordDoc.Close
        
        ElseIf LCase(oOLE.progID) = "package" Then
            sFullFileName = wksDetail.Range("OffImage").Value
            iPos = InStrRev(sFullFileName, "\", -1, vbTextCompare)
            sFileName = Right(sFullFileName, Len(sFullFileName) - iPos)
        
            oOLE.Verb xlVerbOpen 'Open the MS Object Packager
            SendKeys "%FS", True 'Alt-F-S, Save content
            SendKeys rngFileName.Value, True 'Filename with path
            SendKeys "%S", True 'Alt-S, Save button
            SendKeys "%Fx", True 'Alt-F-x, Exit
        
        End If
    Next oOLE
        
End Sub
                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48: