Edit code export size on disk

[Nguyen Anh Dung]

i have a code as below

Sub GetGPSData()
    Application.EnableEvents = False
    Application.AskToUpdateLinks = False
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Dim fso As Object
   ' Dim fi.Name As Variant
    Dim strFo As String
    Dim Stt As Integer
    
    Dim objFo As folder, fo As folder, fi As File
    strFo = Application.InputBox("Enter path Image: ") 'D:\Test_image
    Set fso = CreateObject("Scripting.FileSystemObject")
        Set objFo = fso.GetFolder(strFo)
        For Each fo In objFo.SubFolders
                Set wb = Workbooks.Add
                'wb.Worksheets("Sheet1").Columns("A:G").Clear
                'Range("A2:A" & Rows.Count).ClearContents
                wb.Worksheets("Sheet1").Cells(1, 1).Value = "ID"
                wb.Worksheets("Sheet1").Cells(1, 2).Value = "CategoryName"
                wb.Worksheets("Sheet1").Cells(1, 3).Value = "SubCategoryCode"
                wb.Worksheets("Sheet1").Cells(1, 4).Value = "SubCategoryName"
                wb.Worksheets("Sheet1").Cells(1, 5).Value = "ImageFolder"
                wb.Worksheets("Sheet1").Cells(1, 6).Value = "Image"
                wb.Worksheets("Sheet1").Cells(1, 7).Value = "DateTaken"
                wb.Worksheets("Sheet1").Cells(1, 8).Value = "DateGPS"
                wb.Worksheets("Sheet1").Cells(1, 9).Value = "RLatitude"
                wb.Worksheets("Sheet1").Cells(1, 10).Value = "RLongitude"
                wb.Worksheets("Sheet1").Cells(1, 11).Value = "Size"
            i = 2
            Stt = 1
            For Each fi In fo.Files

                'finame = Dir(fo.Path & "\")
                'While fi.Name <> ""
                'Reference to Microsoft Windows Image Acquisition Library 2.0
                If UCase(Right(fi.Name, 3)) = "JPG" Then
                Set ImgFile = New WIA.ImageFile
                ImgFile.LoadFile (fi.Path)
                With GPSExifReader.OpenFile(fi.Path)
        
                'i = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
'                For Each P In ImgFile.Properties
'                    Debug.Print P.Name
'                Next P
                'Range("A2:A" & Rows.Count).ClearContents
                'wb.Worksheets("Sheet1").Cells(i, 1).Value = 1
                wb.Worksheets("Sheet1").Cells(i, 5).Value = fo.Path
                wb.Worksheets("Sheet1").Cells(i, 6).Value = fi.Name
                On Error Resume Next    ' some of the pictures do not have this data
                wb.Worksheets("Sheet1").Cells(i, 7).Value = Replace(Left(ImgFile.Properties("DateTime"), 10), ":", "-") & Right(ImgFile.Properties("DateTime"), 9)
                wb.Worksheets("Sheet1").Cells(i, 8).Value = Replace(Left(.GPSDateStamp, 10), ":", "-") & " " & .GPSTimeStamp
                wb.Worksheets("Sheet1").Cells(i, 11).Value = FileLen(fi.Path)
                'wb.Worksheets("Sheet1").Cells(i, 5).Value = ImgFile.Properties("GPSDateStamp")
                On Error GoTo 0
        
                'If UCase(Right(fi.Name, 3)) = "JPG" Then
                    'Images only
                    On Error Resume Next
                    iLat = ImgFile.Properties("GpsLatitude")
                    iLatRef = ImgFile.Properties("GpsLatitudeRef")
                    iLng = ImgFile.Properties("GpsLongitude")
                    iLngRef = ImgFile.Properties("GpsLongitudeRef")
                    On Error GoTo 0
                    If Not IsEmpty(iLat) Then
                        LatDec = iLat(1) + iLat(2) / 60 + iLat(3) / 3600
                        If iLatRef = "S" Then LatDec = LatDec * -1
                    Else
                        LatDec = 0
                    End If
                    If Not IsEmpty(iLng) Then
                        LngDec = iLng(1) + iLng(2) / 60 + iLng(3) / 3600
                        If iLngRef = "W" Then LngDec = LngDec * -1
                    Else
                        LngDec = 0
                    End If
                    wb.Worksheets("Sheet1").Cells(i, 9).Value = LatDec
                    wb.Worksheets("Sheet1").Cells(i, 10).Value = LngDec
                                                        i = i + 1
                End With
                           
                End If
        
                   
            Next fi
           
'            For j = 2 To i
'                With Range("D" & j)
'                    Range("D" & j) = Replace(Left(Range("D" & j), 10), ":", "-") & Right(Range("D" & j), 9)
'                    End With
'                Next j

        For j = 2 To i
            With Range("F" & j)
            If Range("E" & j).Value <> "" Then
                Range("B" & j).Formula = "=VLOOKUP(NUMBERVALUE(TRIM(LEFT(C2,4))),[Category.xls]category_full_3_types!$E$1:$H$1098,4,0)"
                Range("C" & j).Value = 9385001
                Range("D" & j).Formula = "=VLOOKUP(C2,[Category.xls]category_full_3_types!$I$1:$L$1098,4,0)"
                
            End If
            End With
        Next j



        Range("A2:A" & Rows.Count).ClearContents
        For j = 2 To i
            With Range("F" & j)
            If Range("E" & j).Value <> "" Then     'neu cot GB khác rong
                Range("A" & j).Value2 = Stt          'dien so thu tu
                Stt = Stt + 1 'tang STT lên 1 cho ô ke tiep
            End If
            End With
        Next j
       
            wb.Worksheets("Sheet1").Columns("G:H").NumberFormat = "yyyy-mm-dd hh:mm:ss"
           ' wb.SaveAs Filename:=fo.Path & "\" & fo.Name, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
            wb.SaveAs Filename:=fo.Path & "\" & fo.Name, FileFormat:=xlWorkbookNormal, CreateBackup:=False
            wb.SaveAs SaveToDirectory & fo.Path & "\" & fo.Name, xlCSV
            wb.Close savechanges:=True
        Next fo
        
            MsgBox "Ho" & ChrW(224) & "n Th" & ChrW(224) & "nh !!!"
            Application.EnableEvents = True
            Application.DisplayAlerts = True
            Application.ScreenUpdating = True
            Application.AskToUpdateLinks = True

End Sub

i have use Filelen export size as picture below. Help me export size on disk of file

Help me export size on disk of file

Best regards,
Nguyen Anh Dung

 

[KOKOSEK]

Divide file size which you already have (2 413 590) by default cluster size for NTFS in W10 (4 096), I suppose that hard drive have been format with default settings, you will get 589. 255371, round it up (590) and multiply by cluster size back, you will get 2 416 640.

read about for ex. Difference Between Size and Size on Disk (with Table) – Ask Any Difference

 

[Nguyen Anh Dung]

Divide file size which you already have (2 413 590) by default cluster size for NTFS in W10 (4 096), I suppose that hard drive have been format with default settings, you will get 589. 255371, round it up (590) and multiply by cluster size back, you will get 2 416 640.

read about for ex. Difference Between Size and Size on Disk (with Table) – Ask Any Difference

thanks you!!! I have edit code run result ok!!!
Best regards,
Dung