I have a code that zips files from a folder that have a certain word in the filename. When I run the macro it seems to find the file okay but then it comes up with an error like "The file name you specified is not valid or too long. Specify a different file name" and I don't know why. Here's a snippet of my code:

Sub Zip()

Dim strDate As String, SavePath As String, sFName As String
Dim oApp As Object, iCtr As Long, I As Integer
Dim vArr, FileNameZip
Dim FName() As Variant

         ' Assign the calling object to a variable.
ButtonName = Application.Caller
RowCount = Cells(Cells.Rows.Count, "c").End(xlUp).Row       ' Value being searched is in column c

For J = 2 To RowCount + 1
    Select Case ButtonName          ' Display the name of the button that was clicked.
        Case Range("B" & J)

            SavePath = "C:\Users\MDuff3\Desktop\" 'save zip location
            strDate = Format(Now, " dd-mmm-yy h-mm-ss")
            FileNameZip = SavePath & ButtonName & strDate & ".zip"

            FName = Array("Y:\Administration\Personnel\Certifications And Identification\CSTP\" & ButtonName & "*")
                If IsArray(FName) = False Then
                        'do nothing
                Else
                        'Create empty Zip File
                    NewZip (FileNameZip)
                    Set oApp = CreateObject("Shell.Application")
                    I = 0
                    For iCtr = LBound(FName) To UBound(FName)
                    vArr = Split97(FName(iCtr), "\") 'splits raw directory into array at each "/"
                    sFName = vArr(UBound(vArr)) 'picks final part of array which is the filename
                If bIsBookOpen(sFName) Then
                MsgBox "You can't zip a file that is open!" & vbLf & _
                       "Please close it and try again: " & FName(iCtr)
                Else
                'Copy the file to the compressed folder
                I = I + 1
                oApp.Namespace(FileNameZip).CopyHere FName(iCtr)
                'Keep script waiting until Compressing is done
                On Error Resume Next
                Do Until oApp.Namespace(FileNameZip).items.Count = I
                    Application.Wait (Now + TimeValue("0:00:01"))
                Loop
                On Error GoTo 0
            End If
        Next iCtr
        MsgBox "You find the zipfile here: " & FileNameZip
    End If

         End Select
Next
      End Sub
The line that is problematic is coloured in red.