添加学生个人信息

解决了如何搜索指定目录下的文件及如何更改文件名并添加学生个人信息

Option Base 1
Sub 添加学生个人信息()
    Dim MyFile As String, MyPath As String, i As Integer, Arr() As String, j As Integer
    Dim wb As Workbook, xm As String, dz As String, MyRange As Range
    Worksheets("sheet1").Activate
    For j = 1 To 25

        MyPath = "E:\yizhong\班主任返回数据\" & Trim(Str(j)) & "\"
        i = 0
        MyFile = Dir(MyPath & "*.jpg")
        Do While Len(MyFile) > 0
            i = i + 1
            ReDim Preserve Arr(i)
            Arr(i) = MyFile
            MyFile = Dir
        Loop
        Set wb = GetObject(ThisWorkbook.Path & "\学生信息.xls")
        With wb.Sheets("yz")
            For i = 1 To UBound(Arr)
                For Each MyRange In .Range(.Cells(2, 1), .Cells(1245, 1))
                    If Left(Arr(i), 19) = MyRange.Value Then
                        xm = MyRange.Offset(0, 2).Value
                        dz = MyRange.Offset(0, 3).Value
                        Debug.Print xm & dz
                        Name ThisWorkbook.Path & "\" & Trim(Str(j)) & "\" & Arr(i) As ThisWorkbook.Path & "\" & Trim(Str(j)) & "\" & Trim(Str(j)) & "班" & xm & dz & Arr(i)
                    End If
                Next MyRange
            Next i
        End With
    Next j
End Sub

很简单的，不用解释了吧？

 今天你菊子曰了么？