「msgファイルから添付ファイルを抽出するスクリプト」といったキーワードでのアクセスがありました。

恐らくエクスポートしたOutlookのメールファイル(msg)から添付ファイルだけを取り出すのが目的なのだろうと思います。

目的の処理は、Outlook経由であれば、NameSpaceオブジェクトのOpenSharedItemメソッドとAttachmentオブジェクトのSaveAsFileメソッドを使うことで処理できるかと思います。

'*************************************************************
' ドラッグ＆ドロップしたmsgファイルから添付ファイルを抽出し、
' 指定したフォルダに保存するスクリプト
' 
' 2015/12/16 @kinuasa
'*************************************************************

Option Explicit

Dim args
Dim olApp
Dim i
Const SaveFolderPath = "C:\Test" '添付ファイルの保存先フォルダ(※要変更)

Set args = WScript.Arguments
If args.Count < 1 Then
  MsgBox "msgファイルを当スクリプトファイルにドラッグ＆ドロップしてください。", vbExclamation + vbSystemModal
  WScript.Quit
End If

With CreateObject("Scripting.FileSystemObject")
  If .FolderExists(SaveFolderPath) = False Then
    MsgBox "添付ファイルの保存先フォルダが見つかりませんでした。" & vbCrLf & _
           "処理を中止します。", vbCritical + vbSystemModal
    WScript.Quit
  End If
  Set olApp = CreateObject("Outlook.Application")
  For i = 0 To args.Count - 1
    If .FileExists(args(i)) = True Then
      Select Case LCase(.GetExtensionName(args(i)))
        Case "msg" 'msgファイルのみ処理
          SaveMsgAttachments olApp, args(i), AddPathSeparator(SaveFolderPath)
      End Select
    End If
  Next
  olApp.Quit
End With

MsgBox "処理が終了しました。", vbInformation + vbSystemModal

Private Sub SaveMsgAttachments(ByVal OutlookApp, ByVal MsgFilePath, ByVal SaveFolderPath)
  Dim itm 'Outlook.MailItem
  Dim atc 'Outlook.Attachment
  Dim fn
  
  With OutlookApp.GetNamespace("MAPI")
    Set itm = .OpenSharedItem(MsgFilePath)
    Select Case LCase(TypeName(itm))
      Case "mailitem"
        If itm.Attachments.Count < 1 Then
          MsgBox "添付ファイルがありません。" & vbCrLf & _
                 "(ファイル名：" & MsgFilePath & ")", vbExclamation + vbSystemModal
          Exit Sub
        Else
          With CreateObject("Scripting.FileSystemObject")
            For Each atc In itm.Attachments
              fn = SaveFolderPath & atc.FileName
              If .FileExists(fn) = True Then
                .DeleteFile fn, True '同名のファイルがあったら事前に削除
              End If
              atc.SaveAsFile fn
            Next
          End With
        End If
    End Select
  End With
End Sub

Private Function AddPathSeparator(ByVal s)
  If Right(s, 1) <> ChrW(92) Then s = s & ChrW(92)
  AddPathSeparator = s
End Function

上記コードでは、msgファイルをスクリプトファイルにドラッグ＆ドロップすることで、指定したフォルダに添付ファイルを保存することが出来ます。