Sub tt()
Dim mydir As String
Dim b As Byte
b = 1
i = 0
Sheets(3).Range("A:A").ClearContents
mydir = Dir("e:\gongshitu" & "\*.*", vbDirectory)
'ThisWorkbook.Path
Do While mydir <> ""
Sheets(3).Cells(b, 1) = mydir
Sheets(3).Cells(b, 5) = WorksheetFunction.Substitute(mydir, "*.jpg", "")
'i = InStrRev(mydir, "\")
'得到总长度
'Sheets(3).Cells(b, 10) = Mid(mydir, i + 1)
'得到后面的*.jpg 一起的文件名
Sheets(3).Cells(b, 12) = Mid(mydir, 1, InStrRev(mydir, ".") - 1) '这样是得到后面的.jpg三个字符
Sheets(3).Cells(b, 13) = Mid(mydir, 1, InStr(mydir, ".") - 1) '这样是得到后面的.jpg三个字符
b = b + 1
mydir = Dir
Loop
End Sub
得到最终结果