Script works in X8, but not in X6

Forgive me, but what about this script makes it not want to work with X6? I run the exact same script through X8 all the time, and it works perfectly. Down close to the bottom of the script, I have highlighted where the Debugger highlights the script when it fails in X6.

Public Sub MBGen()
Dim intCount1 As Long
Dim intCount2 As Long
Dim strRootDir As String
Dim strBlankDir As String
Dim strMBDir As String
Dim strBlankFiles As String
Dim strMBFiles As String
Dim strCdrSave As String
Dim strBaseFile As String
strRootDir = "P:\MB\"
strBlankDir = strRootDir & "blanks\"
strMBDir = strRootDir & "MB\"
strWebDir = strRootDir & "out\web\"
strCdrDir = strRootDir & "out\cdr\"
'Create a dynamic array variable, and then declare its initial size
Dim arrBlanks() As String
Dim arrMB() As String
ReDim arrBlanks(1000)
ReDim arrMB(1000)
'Loop through all the files in the MB directory by using Dir$ function
strMBFiles = Dir$(strMBDir & "*.png")
Do While strMBFiles <> ""
arrMB(intCount1) = Left(strMBFiles, Len(strMBFiles) - 4)
'arrMB(intCount1) = Replace(strMBFiles, ".PNG", "")
strMBFiles = Dir$
intCount1 = intCount1 + 1
'Debug.Print intCount1
Loop
'Loop through all the files in the Blanks directory by using Dir$ function
strBlankFiles = Dir$(strBlankDir & "*.cdr")
Do While strBlankFiles <> ""
'arrBlanks(intCount2) = Replace(strBlankFiles, ".cdr", "")
arrBlanks(intCount2) = Left(strBlankFiles, Len(strBlankFiles) - 4)
strBlankFiles = Dir$
intCount2 = intCount2 + 1
'Debug.Print intCount2
Loop
'Reset the size of the array without losing its values by using Redim Preserve
ReDim Preserve arrBlanks(intCount2 - 1)
ReDim Preserve arrMB(intCount1 - 1)
' To prove it worked you could run the following:
For intCount2 = 0 To UBound(arrMB)
For intCount1 = 0 To UBound(arrBlanks)
strCdrSave = strCdrDir & arrMB(intCount2) & "-" & arrBlanks(intCount1) & ".cdr"
strPngSave = strWebDir & arrMB(intCount2) & "-" & arrBlanks(intCount1) & ".png"
strBaseFile = strBlankDir & arrBlanks(intCount1) & ".cdr"
If Dir$(strCdrSave) = "" Then
'Debug.Print writes the results to the Immediate window (press Ctrl + G to view it)'
'Debug.Print arrMB(intCount2) & " " & arrBlanks(intCount1)
'open base file
cdrOpen (strBaseFile)

'I'm making changes here on 4/16/19
'ItemImage (strMBDir & arrMB(intCount2))'
'**********************************************'
'this was the original line on 4/16
ItemImage (strMBDir & arrMB(intCount2) & ".png")
'**********************************************'
Debug.Print ("Saving " & arrMB(intCount2) & "-" & arrBlanks(intCount1))
ActiveDocument.SaveAs (strCdrSave)
Debug.Print ("Exporting " & arrMB(intCount2) & "-" & arrBlanks(intCount1))
'export the png
pngExport (strPngSave)
'close the file, rinse, lather, and repeat
ActiveDocument.Close
End If
Next intCount1
Next intCount2
End Sub
Private Sub pngExport(ByVal strExport As String)
ActivePage.Shapes.All.CreateSelection
' jpgW = 960
' jpgH = 1200
Set s = ActiveSelection
sw = s.SizeWidth
sHght = s.SizeHeight
If sw > sHght Then
'OLD CODE'
ratio = sHght / sw
jpgW = 1000
jpgH = jpgW * ratio
Else
'NEW CODE'
jpgW = ((1000 * sw) / sHght)
jpgH = 1000
End If

'jpgH = 1200
'jpgW = ((jpgH * sw) / sHght)
Set expflt = ActiveDocument.ExportBitmap(strExport, cdrPNG, cdrSelection, cdrRGBColorImage, jpgW, jpgH, 450, 450, cdrNormalAntiAliasing, False, True, True, False, cdrCompressionNone)
With expflt
.Interlaced = True
.Transparency = 0
.invertmask = False
.Color = 0
.Finish
End With
End Sub
Private Sub cdrOpen(ByVal strCDR As String)
Dim openopt As StructOpenOptions
Set openopt = CreateStructOpenOptions
With openopt.ColorConversionOptions
.SourceColorProfileList = "sRGB IEC61966-2.1,U.S. Web Coated (SWOP) v2,Dot Gain 20%"
.TargetColorProfileList = "sRGB IEC61966-2.1,U.S. Web Coated (SWOP) v2,Dot Gain 20%"
End With
Dim doc1 As Document
Set doc1 = OpenDocumentEx(strCDR, openopt)
End Sub
Private Sub ItemImage(ByVal strMBFile As String)
Dim impopt As StructImportOptions
Set impopt = CreateStructImportOptions
With impopt
.Mode = cdrImportFull
.MaintainLayers = True
With .ColorConversionOptions
.SourceColorProfileList = "sRGB IEC61966-2.1,U.S. Web Coated (SWOP) v2,Dot Gain 20%"
.TargetColorProfileList = "sRGB IEC61966-2.1,U.S. Web Coated (SWOP) v2,Dot Gain 20%"
End With
End With
Dim impflt As ImportFilter
Set impflt = ActiveLayer.ImportEx(strMBFile, cdrPNG, impopt)
impflt.Finish
Dim s1 As Shape
Set s1 = ActiveShape
ActiveLayer.Shapes(1).Move -3.061949, -2.794587
ActiveDocument.ReferencePoint = cdrCenter
ActiveLayer.Shapes(1).SetPosition -0.3, 9.35
End Sub