Three code Fragments I love!

[LearnExcel]

How can I tell if a file exists in a specific folder? 

Function bFileExists(rsFullPath As String) As Boolean 
  bFileExists = CBool(Len(Dir$(rsFullPath)) > 0)
End Function 
-------------------------------------------------------
How can I tell if a specific workbook is open? 

Function bWorkbookIsOpen(rsWbkName As String) As Boolean 
On Error Resume Next 
  bWorkbookIsOpen = CBool(Len(Workbooks(rsWbkName).Name) > 0) 
End Function  

--------------------------------------------------------
How can I tell if a specific worksheet exists? 

Function WksExists(wksName As String) As Boolean
    On Error Resume Next
    WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function


You can call this function from your code, e.g.: 
Msgbox WksExists("Sheet19")

Nguồn
http://www.contextures.com/xlfaqMac.html

Còn bạn có thích chúng không?

 

[anhtuan1066]

Bạn nè: Việc xác định 1 file hoặc 1 sheet có tồn tại hay ko thì tôi còn biết nó sử dụng vào việc gì... Còn việc biết 1 Workbook đang mở hay ko tôi ko biết nó dùng đễ làm gì cả... Bạn có thể nêu ra 1 ứng dụng nào đó dc ko?
Mến
ANH TUẤN

 

[LearnExcel]

Yet Another

Phiên bản khác kiểm tra WB mở hay không?

Tôi thấy cũng hay và đang dùng

Public Function CheckWorkbookIsOpen(ByVal FileName As String) As Boolean    'true if open
    Dim wBook As Workbook
    On Error Resume Next
    Set wBook = Workbooks(FileName)
    CheckWorkbookIsOpen = (wBook Is Nothing)    ' Directly refer!
    Set wBook = Nothing    '"Garbage collection" Need!!!

End Function

 

[LearnExcel]

Bạn nè: Việc xác định 1 file hoặc 1 sheet có tồn tại hay ko thì tôi còn biết nó sử dụng vào việc gì... Còn việc biết 1 Workbook đang mở hay ko tôi ko biết nó dùng đễ làm gì cả... Bạn có thể nêu ra 1 ứng dụng nào đó dc ko?
Mến
ANH TUẤN

Nếu bạn có ứng dụng VBA truy cập tới 1 file và gặp thông báo như sau:


Thì code sẽ dừng lại hỏi bạn có mở hay không? Quá "quê"!
Bạn sẽ thấy nó hữu ích

Đây là 1 ví dụ tôi sử dụng

Function BCTP(ByVal s) As String
    BCTP = "TRUNG" & Format(s + c, "00") & ".XLS"
End Function

Public Function EOM(ByVal i As Integer) As Long
    If Year(Now()) Mod 4 = 0 And (Year(Now()) Mod 100 <> 0) Or (Year(Now()) Mod 400 = 0) Then ho = 29 Else ho = 28
    Mo = Array(31, ho, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)
    EOM = Mo(i - 1)
    'hack Jan 2006
    If Year(Now()) = 2006 And i = 1 Then EOM = 27
End Function

Public Function CheckWorkbookIsOpen(ByVal FileName As String) As Boolean    'true if open
    Dim wBook As Workbook
    On Error Resume Next
    Set wBook = Workbooks(FileName)
    CheckWorkbookIsOpen = (wBook Is Nothing)    ' Directly refer!
    Set wBook = Nothing    '"Garbage collection" Need!!!

End Function

Public Sub CAPNHAT()    'lam bao cao tu dau
'Exit Sub
'start = Timer
    Dim BM As Integer, eM As Integer, B_day As Integer, E_day As Integer, i_m As Integer, I_d As Integer, xp As Integer, _
        d1 As Integer, d2 As Integer    ', j As Integer
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    pr = ThisWorkbook.Name
    If Year(Date) < 2006 Then GoTo Exit_Sub
    With Workbooks(pr).Sheets("INTERFACE")

        BM = Cells(5, 3).Value    ' THANG BAT DAU
        eM = Cells(5, 4).Value    'THANG HIEN THOI
        d1 = Cells(4, 3).Value
        d2 = Cells(4, 4).Value
        xp = Cells(7, 3).Value    ' bien nho cuoi
    End With
    If d1 = d2 And BM = eM Then GoTo Exit_Sub
    Dim p1 As Integer
    p1 = xp
    For i_m = BM To eM    'LAP TU THANG BAT DAU DEN KET THUC

        Select Case BM - eM
        Case 0
            B_day = d1
            E_day = d2
        Case -1
            If i_m = BM Then
                B_day = d1
                E_day = EOM(i_m)
            Else
                B_day = 0
                E_day = d2
            End If
        Case Else
            B_day = 0
            E_day = EOM(i_m)
        End Select
        '//// Kiem tra tinh trang cua file, neu chua thi mo

        '//// Mo bao cao thanh pham
        ChDrive "H:": ChDir P & TP

        If [B][COLOR="Red"][SIZE="4"]CheckWorkbookIsOpen(BCTP(i_m))[/SIZE][/COLOR][/B] Then Workbooks.Open BCTP(i_m), 0, True, , , , True
        '//// Chay toi sheet can bao cao
        For I_d = B_day + 1 To E_day
            Dim ts As Integer, j As Integer
            'If Year(Now()) = 2004 And (i_m <= 3 Or (i_m = 4 And I_d < 13)) Then ts = 13 Else ts = 10
            'tu thang 4-2006 tro di, them 1 hang nua vao cho JB
            'tu 16 thang 7 nam 2006 them 1 hang cho PCB40
            If Year(Now()) = 2006 And (i_m >= 4) Then
                ts = 11
                'ElseIf Year(Now()) >= 2006 And (i_m >= 7) And I_d >= 16 Then
                '    ts = 12
            Else
                ts = 10
            End If

            For j = 1 To ts
                Dim shTP As Worksheet
                Set shTP = Workbooks(BCTP(i_m)).Sheets(I_d)
                Dim lot As String, cat As String, spl As String
                lot = shTP.Cells(16 + j, 28).Value
                Debug.Print lot
                If Len(lot) > 0 And Len(lot) < 9 Then  'original 5
                    xp = xp + 1
                    With Workbooks(pr).Sheets(ORI)
                        .Cells(xp, 1).Value = DateSerial(Year(Date), i_m, I_d)
                        .Cells(xp, 2).Value = shTP.Cells(16 + j, 28).Value
                        .Cells(xp, 3).Value = shTP.Cells(16 + j, 29).Value
                        .Cells(xp, 4).Value = shTP.Cells(16 + j, 30).Value
                        .Cells(xp, 5).Value = shTP.Cells(16 + j, 31).Value
                        .Cells(xp, 6).Value = shTP.Cells(16 + j, 32).Value
                        .Cells(xp, 7).Value = shTP.Cells(16 + j, 33).Value
                    End With
                    cat = CatFunc(lot)
                    spl = SupFunc(lot)

                    With Workbooks(pr).Sheets(ORI)
                        .Cells(xp, 9).Value = cat
                        .Cells(xp, 8).Value = spl
                        .Cells(xp, 10).Value = i_m
                    End With
                End If
            Next
            Set shTP = Nothing

        Next I_d
        Workbooks(BCTP(i_m)).Close False    'Dong file BCTP khong save
    Next
    With Workbooks(pr).Sheets(ORI)
        Cells(4, 3).Value = Day(Sheets("khovb").Cells(xp, 1).Value)
        Cells(5, 3).Value = i_m - 1
        Cells(7, 3).Value = xp
    End With
Exit_Sub:
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

Thân mến

 

[SoiBien]

Còn bạn có thích chúng không?

Bẫy On Error cũng có cái hay của nó chứ nhỉ, quá ngắn gọn, Tuyệt!