写一段vba代码，将word所有图片另存为桌面

Sub SaveAllImages()
Dim objDoc As Document
Dim objShape As Shape
Dim strDesktopPath As String
Dim strFilePath As String

'获取桌面路径
strDesktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")

'获取当前文档
Set objDoc = ActiveDocument

'遍历所有形状
For Each objShape In objDoc.Shapes
'如果是图片
If objShape.Type = msoPicture Then
'获取文件路径
strFilePath = strDesktopPath & "\" & objShape.Name & "." & objShape.LinkFormat.SourceFullName
'保存图片
objShape.Export strFilePath, objShape.LinkFormat.SourceFullName
End If
Next objShape

'释放对象
Set objShape = Nothing
Set objDoc = Nothing
End Sub