Code kiểm tra độ lớn File

[hoahuongduong1986]

Kính gửi Anh Chị diễn đàn,
Em có vấn đề chưa gặp bao giờ muốn nhờ mọi người trợ giúp ạ. Em làm việc với một File thường khoảng 30 MB, hạn chế là nó không gửi được mail cho người khác vì thường dưới 10MB mới gửi được mail. Em đã dùng giải pháp xóa đi một số nội dung trong Sheet 1 (Cái này em đã làm xong với SUB Xoa ()). Giờ em muốn làm Code là khi em bấm tắt File này, đoạn Code này sẽ phát huy tác dụng với các bước sau trước khi tắt File.
(1) Nó kiểm tra dung lượng File đang làm việc Nếu dung lượng File < 10MB thì lưu File và tắt
(2) Nếu dung lượng File đang làm việc dung lượng >=10 MB thì nó sẽ thực hiện lệnh xóa rồi mới lưu File ạ.
Em có thể miêu tả yêu cầu như sau ạ.
Tự áp dụng Code này khi tắt File.
IF Dung lượng File < 10 MB then Save File và Close
Else Dung lượng File >= 10 MB then Call Xoa then Save File và Close

 

[ThangCuAnh]

Trong event Workbook_BeforeClose, bạn thêm đoạn code sau vào thử nhé. Nhớ thêm mắm thêm muối cho đúng yêu cầu của bạn

Option Explicit

Private Const MAX_FILE_SIZE As Long = 10000000

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim lSize As Long
    Dim bChanged As Boolean

    ' Save workbook de update file size thuc
    If Not ThisWorkbook.Saved Then ThisWorkbook.Save
    
    bChanged = False
    lSize = FileLen(ThisWorkbook.FullName)
    If lSize > MAX_FILE_SIZE Then
        bChanged = True
        ' Your code here
        ' .............
    End If
    
    If bChanged Then ThisWorkbook.Save
End Sub

 

[hoahuongduong1986]

Trong event Workbook_BeforeClose, bạn thêm đoạn code sau vào thử nhé. Nhớ thêm mắm thêm muối cho đúng yêu cầu của bạn

Option Explicit

Private Const MAX_FILE_SIZE As Long = 10000000

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim lSize As Long
    Dim bChanged As Boolean

    ' Save workbook de update file size thuc
    If Not ThisWorkbook.Saved Then ThisWorkbook.Save
   
    bChanged = False
    lSize = FileLen(ThisWorkbook.FullName)
    If lSize > MAX_FILE_SIZE Then
        bChanged = True
        ' Your code here
        ' .............
    End If
   
    If bChanged Then ThisWorkbook.Save
End Sub

Em cảm ơn Anh đã giúp em ạ !

 

[ongke0711]

Kính gửi Anh Chị diễn đàn,
Em có vấn đề chưa gặp bao giờ muốn nhờ mọi người trợ giúp ạ. Em làm việc với một File thường khoảng 30 MB, hạn chế là nó không gửi được mail cho người khác vì thường dưới 10MB mới gửi được mail. Em đã dùng giải pháp xóa đi một số nội dung trong Sheet 1 (Cái này em đã làm xong với SUB Xoa ()). Giờ em muốn làm Code là khi em bấm tắt File này, đoạn Code này sẽ phát huy tác dụng với các bước sau trước khi tắt File.
(1) Nó kiểm tra dung lượng File đang làm việc Nếu dung lượng File < 10MB thì lưu File và tắt
(2) Nếu dung lượng File đang làm việc dung lượng >=10 MB thì nó sẽ thực hiện lệnh xóa rồi mới lưu File ạ.
Em có thể miêu tả yêu cầu như sau ạ.
Tự áp dụng Code này khi tắt File.
IF Dung lượng File < 10 MB then Save File và Close
Else Dung lượng File >= 10 MB then Call Xoa then Save File và Close

Sao bạn không upload file lên Google Drive rồi gửi link nhỉ.