ShellApplication "CopyHere" randomly deleting files

Question

I have the following VBScript program to zip up files. It works fine most of the time, except that it seems to occasionally delete a file that it is zipping! This condition is trapped by the script. Can anyone suggest what might be causing this? Code is:

'
' VBScript to compress all files in a specified directory that match a given prefix and suffix.
' Matching files are compressed to a zip file called <prefix>.zip, created in the same specified directory.
' Option to either keep original files or clobber (delete) them once they've been zipped.
' See Entry Point and usage at foot of files for details and how to invoke.
' Failure is reported by screen output and errorlevel 1, so can be tested from a batch file.

'
' Create a file that looks exactly like an empty zip file
'
Function CreateEmptyZip(folder, zipPrefix)
  Dim strZIPHeader
  Dim fso
  Dim sPath

  strZIPHeader = Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, 0) ' header required to convince Windows shell that this is really a zip file
  Set fso = CreateObject("Scripting.FileSystemObject")
  sPath = CStr(fso.GetFolder(folder)) & "\" & zipPrefix & ".zip" ' getFolder trims trailing \ if it's there
  fso.CreateTextFile(sPath).Write strZIPHeader
  Set fso = Nothing
  CreateEmptyZip = sPath
End Function

'
' Get files in folder that start with filePrefix and end in fileSuffix.
' Put the matches into outputAry
'
Sub GetMatchingFiles(folder, filePrefix, fileSuffix, outputAry)
  Dim fso, f, f1, fc, name, f1Prefix, f1Suffix, count
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set f = fso.GetFolder(folder)
  Set fc = f.Files
  count = 0

  For Each f1 in fc
    f1Prefix = mid(f1, len(f1.ParentFolder)+2, len(filePrefix))
    f1Suffix = right(f1, len(fileSuffix))

    If f1Prefix = filePrefix and f1Suffix = fileSuffix Then
      redim preserve outputAry(count)
      outputAry(count) = CStr(f1)
      count = count + 1
    End If

  Next

  ' put a dummy entry in at the end
  redim preserve outputAry(count)
  outputAry(count) = ""

  Set fc = Nothing
  Set f = Nothing
  Set fso = Nothing

End Sub

'
' check files are still there
' return a list of those that have vanished
'
Function CheckFilesStillThere(fileList)
  Dim fso
  Dim fileIx
  CheckFilesStillThere = ""
  Set fso = CreateObject("Scripting.FileSystemObject")
  For fileIx = Lbound(fileList) to Ubound(fileList) - 1
    If Not fso.FileExists(fileList(fileIx)) Then
      If CheckFilesStillThere = "" Then
        CheckFilesStillThere = "ERROR: file(s) deleted during Zip: " + fileList(fileIx)
      Else
        CheckFilesStillThere = CheckFilesStillThere  + ", " + fileList(fileIx)
      End If
    End If
  Next
  Set fso = Nothing
End Function


'
' key function: find files in folder that start with filePrefix and end in fileSuffix, and
' put them into a zip file.
'
Function ZipThem(folder, filePrefix, fileSuffix)

  Dim shellApp
  Dim ns
  Dim fileList()
  Dim addCount
  Dim fileIx
  Dim zipFile
  Dim timeoutSecs

  ZipThem = "" ' empty string denotes success

  Call GetMatchingFiles(folder, filePrefix, fileSuffix, fileList)

  ' there is no length operation for arrays !!!
  If UBound(fileList) = LBound(fileList) Then
    'MsgBox "No files to process"
    Exit Function
  End If

  ' otherwise press on
  zipFile = CreateEmptyZip(folder, filePrefix)

  Set shellAp = CreateObject("Shell.Application")
  Set ns = shellAp.Namespace(zipFile)

  addCount = 0
  For fileIx = Lbound(fileList) to Ubound(fileList) - 1
    ns.CopyHere fileList(fileIx) ' <=== this copies a file to the Zip file
    addCount = addCount + 1
    ' wait for it to finish
    timeoutSecs = 0
    While (ns.items.count <> addCount)
      ' give it a second
      wscript.sleep(1000)
      timeoutSecs = timeoutSecs + 1
      ' after 5 minutes, something is wrong
      If timeoutSecs = 300 Then
        ZipThem = "ERROR: Zip Timed Out"
        Set ns = Nothing
        Set shellAp = Nothing
        Exit Function
      End If
    Wend
  Next

  Set ns = Nothing
  Set shellAp = Nothing

  ' have seen cases where files are removed by this operation !!
  ZipThem = CheckFilesStillThere(fileList)
  If ZipThem <> "" Then
    Exit Function
  End If

End Function

' Entry Point
Dim usage
Dim result
usage = "Usage: CompressFiles folder file_prefix extension"
If WScript.Arguments.Count <> 3 Then
  WScript.echo usage
  WScript.Quit(1)
Else
  result = ZipThem(WScript.Arguments.Item(0), WScript.Arguments.Item(1), WScript.Arguments.Item(2))
  If result = "" Then
    WScript.Quit(0)
  Else
    WScript.echo result
    WScript.Quit(1)
  End If ' result of ZipThem
End If ' argc != 3