VBA to save file to sharepoint folder

Hello, I have code that filters a file for all unique records in col A and saves a file for each set of unique records. so if there are 5 unique records, there would be 5 files created. the problem I am having is trying to save the files to sharepoint. I am able to save to sharepoint when there are no symbols or alpha numeric characters in the folder. I used an Alphanumeric function to try to remove the special characters from the name before saving to the folder, but I am getting a 'index refers beyond the list' error and I am not sure how to resolve it yet. Please provide some assistance. Below is the code and Ive bolded the error and line causing error. I also included the Alphanumeric function I have used :

Private Sub CommandButton4_Click()
 
Dim strFile_location1 As String
Dim strFile_location2 As String
Dim strFile_location3 As String
Dim strFile_location4 As String
Dim strFile_location5 As String
Dim strFile_location6 As String
Dim strFile_location7 As String
Dim strFile_location8 As String
Dim strFile_location9 As String
Dim strFolder As String
Dim strOutputFolder As String
Dim strFilename As String
Dim wb As Workbook
Dim wb1 As Workbook
Dim ws As Worksheet
Dim ws1 As Worksheet
Dim file As String
Dim d As String
Dim d1 As String
Dim strItemz As String
 
strFile_location1 = Sheets("Front_End_App").Range("SourceFile").Value
strFile_location2 = Sheets("Front_End_App").Range("ReportOutput").Value
strFile_location3 = Sheets("Front_End_App").Range("OutputData").Value
strFile_location4 = Sheets("Front_End_App").Range("SourceData").Value
strFile_location5 = Sheets("Front_End_App").Range("Database").Value
strFile_location6 = Sheets("Front_End_App").Range("OutputData2").Value
strFile_location7 = Sheets("Front_End_App").Range("FolderNames").Value
strFile_location8 = Sheets("Front_End_App").Range("ReportOutput2").Value
strFile_location9 = Sheets("Front_End_App").Range("ReportOutput3").Value
 
 
Sheets("Front_End_App").Select
 
 
d = Range("ReportOutput").text
If Dir(d, vbDirectory) <> "" Then
MsgBox d & " already exists", , "Error"
Else
MkDir d
End If
 
    Dim xdir As String
    Dim fso
    Dim lstrow As Long
    Dim i As Long
    Dim file1 As String
   
''file1 = "C:\Remitter Database\Remitter DB Setup Files\ClientFolderNames.csv"
'Workbooks.Open file1
   
    Set fso = CreateObject("Scripting.FileSystemObject")
    lstrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
    Application.ScreenUpdating = False
    For i = 1 To lstrow
        'change the path on the next line where you want to create the folders
        xdir = "C:\Remitter Database\Remitter Reports\Folders\" & Range("A" & i).Offset(1, 0).Value
        If Not fso.FolderExists(xdir) Then
            fso.CreateFolder (xdir)
        End If
    Next
    Application.ScreenUpdating = True
 
file = "C:\Remitter Database\Remitter DB Setup Files\RemitterOutputData1.xls"
Workbooks.Open file
wb = ThisWorkbook.Name
 
 
iCol = 1                                     '### Define your criteria column
strOutputFolder = strFile_location8        '### Define your path of output folder
Set ws = Worksheets("RemitterOutputData1")   '### Don't edit below this line
Set rngLast = Columns(iCol).Find("*", Cells(1, iCol), , , xlByColumns, xlPrevious)
ws.Columns(iCol).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Set rngUnique = Range(Cells(2, iCol), rngLast).SpecialCells(xlCellTypeVisible)
 
If Dir(strOutputFolder, vbDirectory) = vbNullString Then MkDir strOutputFolder
For Each strItem In rngUnique
  If strItem <> "" Then
    ws.UsedRange.AutoFilter Field:=iCol, Criteria1:=strItem.Value
    Workbooks.Add
    ws.UsedRange.SpecialCells(xlCellTypeVisible).Copy Destination:=[A1]
   
   
    strFilename = strOutputFolder & "\" & AlphaNumericOnly(mid(strItem, 9)) & "\" & strItem
   
     'Sheets("Front_End_App").Cells(6, 6).Value = strFilename
   
    Columns("J:J").Select
    Selection.Style = "Currency"
    Selection.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
   
    Columns("L:L").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Delete Shift:=xlToLeft
   
    ActiveWorkbook.SaveAs Filename:=strFilename, FileFormat:=xlNormal
    ActiveWorkbook.Close savechanges:=False
   
    
  End If
Next
ws.ShowAllData
 
Application.DisplayAlerts = False
 
ActiveWorkbook.Close
 
Application.ScreenUpdating = True
Application.DisplayAlerts = True
 
MsgBox ("DONE!!")
 
End Sub

Alphanumeric function code

Function AlphaNumericOnly(strSource As String) As String
    Dim i As Integer
    Dim strResult As String

    For i = 1 To Len(strSource)
        Select Case Asc(Mid(strSource, i, 1))
            Case 48 To 57, 65 To 90, 97 To 122: 'include 32 if you want to include space
                strResult = strResult & Mid(strSource, i, 1)
        End Select
    Next
    AlphaNumericOnly = strResult
End Function