|
Sub lll()
Dim Sht As Worksheet
Dim Rng As Range
Set Sht = Sheet1
''Debug.Print Sht.Cells.Rows.Count
Set Rng = Sht.Range("B1:AZ65536")
Rng.Clear
Sht.Cells.Font.Size = 9
Rr = Sht.Range("A6566").End(xlUp).Row
Rr = 5
Set Rng = Sht.Cells(Rr, 1)
TraverserJPG Rng, ThisWorkbook.Path
End Sub
Function TraverserJPG(Rng As Range, Path)
Dim xlWk As Workbook
Dim xlSht As Worksheet
Set xlWk = ConnectWk("F:\日出日落时间\中国东西南北城市.xlsm")
Dim Sht As Worksheet
Dim Fso As Scripting.FileSystemObject
Dim oFile As File, oFilesAs As Files
Dim oFolder As Folder
Dim Img As WIA.ImageFile
Dim oDate As Date
Dim Rr, Cc
Dim Str
Set Img = New WIA.ImageFile
Set Sht = Rng.Parent
Set xlSht = xlWk.Worksheets("珠海") 'Sht.Cells(Rng.Row, 1))
Rr = Rng.Row + 2
Cc = 2
Set Fso = New Scripting.FileSystemObject
Set oFolder = Fso.GetFolder(Path)
''
For Each oFile In oFolder.Files
If InStr(oFile.Type, "JPEG") > 0 Then
With Sht
Img.LoadFile oFile.Path
'.Cells(Rr, Cc + 1) = oFile.Name
'Debug.Print oFile.Name, oFile.ParentFolder.Name, oFile.ParentFolder.ShortPath
.Cells(Rr, Cc + 9) = oFile.DateLastModified
'Str = oFile.DateLastModified
oDate = .Cells(Rr, Cc + 9)
Str = Format(oDate, "yyyy年m月d日") & _
Format(oDate, "[$-zh-CN]aaaa;@") & Format(oDate, "hh:mm:ss") '",全年过去" & DatePart("y", oDate, vbUseSystemDayOfWeek)
.Cells(Rr, Cc + 1) = Str
.Cells(Rr, Cc + 2) = GetYLDate(oFile.DateLastModified)
.Cells(Rr, Cc + 6) = oFile.Name
.Cells(Rr, Cc + 3) = Format(Int(oFile.Size / 1024), "0,000")
.Cells(Rr, Cc + 7) = "\" & oFile.ParentFolder.Name & "\"
.Cells(Rr, Cc + 4) = Img.Width
.Cells(Rr, Cc + 5) = Img.Height
.Cells(Rr, Cc + 8) = oFile.Type
.Cells(Rr, Cc + 12) = oFile.Path
.Cells(Rr, Cc + 13) = Img.Width
.Cells(Rr, Cc + 14) = Img.Height
End With
End If
Rr = Rr + 1
Next oFile
Set Rng = Sht.Cells(Rr + 2, 1)
''
For Each oFolder In oFolder.SubFolders
TraverserJPG Rng, oFolder.Path
Next oFolder
xlWk.Close
End Function
|
评分
-
1
查看全部评分
-
|