用宏插入对应图片生成Word

[Yuesc]

由于工作关系需要把对应的图片插入到word，最近工作要求变了，原来编写的代码已经不能满足工作的需求，我想修改但是下面的代码对于我这种菜鸟来说还是不怎么懂原来代码可以一次插入3个图，但是现在要求要插入4个图，但是我明白要从哪里入手，求大神帮忙！！


代码如下：


Option Explicit


Public Sub InsertPOD()
Dim objFS As Object
Dim podLocation
Dim podFileCollection
Dim podImg

Dim ScreenCaptureLocation
Dim ScreenCaptureCollection
Dim ScreenCapture

Dim myArr(1000) As String
Dim myArrCon() As String
Dim i As Integer
Dim Amount As Integer

Dim con As String
Dim PicPath As String
Dim PodPath As String
Dim SavePath As String
Dim WaybillPath As String

Dim addPath As String

con = ActiveDocument.Content.Text
myArrCon = VBA.Split(con, Chr(13))
PicPath = myArrCon(0) & "\"
PodPath = myArrCon(2) & "\"
SavePath = myArrCon(1)

addPath = myArrCon(3) & "\"



Set objFS = CreateObject("Scripting.FileSystemObject")
Set podLocation = objFS.getfolder(myArrCon(0))
Set podFileCollection = podLocation.Files

On Error Resume Next

i = 1
For Each podImg In podFileCollection

myArr(i) = Left(podImg.Name, 16)

i = i + 1
Next

Amount = i - 1
i = 1

If myArrCon(3) = "" Then
Do While i <= Amount
Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
Selection.InlineShapes.AddPicture FileName:=PicPath & myArr(i) & ".tif", LinkToFile:=False, SaveWithDocument:=True

Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeParagraph

Selection.InlineShapes.AddPicture FileName:=PodPath & myArr(i) & ".tif", LinkToFile:=False, SaveWithDocument:=True

ChangeFileOpenDirectory SavePath

ActiveDocument.SaveAs FileName:=myArr(i) & ".doc"

ActiveDocument.Close
i = i + 1
Loop
Else
Do While i <= Amount
Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
Selection.InlineShapes.AddPicture FileName:=PicPath & myArr(i) & ".tif", LinkToFile:=False, SaveWithDocument:=True

Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeParagraph
Selection.InlineShapes.AddPicture FileName:=PodPath & myArr(i) & ".tif", LinkToFile:=False, SaveWithDocument:=True

Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeParagraph
Selection.InlineShapes.AddPicture FileName:=addPath & myArr(i) & ".tif", LinkToFile:=False, SaveWithDocument:=True


ChangeFileOpenDirectory SavePath

ActiveDocument.SaveAs FileName:=myArr(i) & ".doc"

ActiveDocument.Close
i = i + 1
Loop
End If



End Sub