[5分]从多个EXCEL文件中导入到ACCESS中一个表并改文件名

改一下代码(红色部分)：

Private Sub cmdIn_Click()
    Dim strFileName As String   '获取的文件名及完整路径
    Dim strPath As String    '路径
    Dim I As Integer    '循环变量

　　dim n as long
    Dim Arr                     '申明数组

    On Error Resume Next
    '****************************************************
    '获取文件名及完整路径
    strFileName = GetFileName("Open", "*.xls", "xls")

    '****************************************************
    '分割并寄入数组
    Arr = Split(strFileName, Chr(0))

    '****************************************************
    '因为多选后在有时会有"\",有时又没有"\" _
     因此通过此判断补齐 "\"
    If Right(Arr(0), 1) <> "\" Then
        strPath = Arr(0) & "\"
    Else
        strPath = Arr(0)
    End If

    '****************************************************
    '输出含文件名的多选或是单选的完整路径
    ' List1.RowSource = ""                  '清空列表框数据
    Me.frmChild.SourceObject = ""
    If UBound(Arr) >= 4 Then
        For I = 1 To UBound(Arr) - 3
            DoCmd.TransferSpreadsheet acImport, 8, "tblList", strPath & Arr(I), True, ""
            n = Len(strPath & Arr(I)) - 4
            Name strPath & Arr(I) As Left(strPath & Arr(I), n) & "已导入.xls"

        Next
    Else
        DoCmd.TransferSpreadsheet acImport, 8, "tblList", strFileName, True, ""
        n = Len(strFileName) - 4

        Name strPath & Arr(I) As Left(strFileName, n) & "已导入.xls"

    End If
    Me.frmChild.SourceObject = "frmList"
End Sub