Code VBA để nhận biết FILE EXCEL CÓ LIÊN KẾT CÓ MỞ hay KHÔNG?

Liên hệ QC

thanh2581990

Thành viên mới
Tham gia
17/6/13
Bài viết
18
Được thích
2
Mình có 1 vấn đề như sau:
Mình sài 2 file excel. VD: 1 file tên A, 1 file tên B
Mình cần 1 đoạn code khi thao tác trên file A, nó sẽ kiếm coi file B có mở không? Nếu file B có mở thì tiếp tục thực hiện các lệnh phía sau.
Còn nếu file B không mở thì nó sẽ dừng không chạy nữa và hiện 1 cái Msgbox "File B không mở không thể thực hiện. Vui lòng mở file B".

Mong ACE góp ý.

Cảm ơn ACE đã quan tâm.

Thân!
 
Mình đã tìm ra cách rùi. Thay vì kiểm tra nó có mở hay không thì mình thêm vào đoạn code mở file liên kết lên là mọi chuyện đc giải quyết.
Thanks mọi người đã quan tâm.

Thân!
 
Mình có 1 vấn đề như sau:
Mình sài 2 file excel. VD: 1 file tên A, 1 file tên B
Mình cần 1 đoạn code khi thao tác trên file A, nó sẽ kiếm coi file B có mở không? Nếu file B có mở thì tiếp tục thực hiện các lệnh phía sau.
Còn nếu file B không mở thì nó sẽ dừng không chạy nữa và hiện 1 cái Msgbox "File B không mở không thể thực hiện. Vui lòng mở file B".

Mong ACE góp ý.

Cảm ơn ACE đã quan tâm.

Thân!
bạn thử code sau nhớ sửa lại tên File và hai File phải cùng chung Folder
PHP:
Function IsFileOpen(FileName As String)
    Dim iFilenum As Long, iErr As Long
    On Error Resume Next
    iFilenum = FreeFile()
    Open FileName For Input Lock Read As #iFilenum
    Close iFilenum
    iErr = Err
    On Error GoTo 0
    Select Case iErr
        Case 0:    IsFileOpen = False
        Case 70:   IsFileOpen = True
        Case Else: Error iErr
    End Select
End Function
Chạy Sub này
PHP:
Sub CheckFile()
    Dim FileName As String
    FileName = ThisWorkbook.Path & "\B.xlsb"
    If IsFileOpen(FileName) Then
        MsgBox "File Dang Mo", 64, "Thông Báo"
    Else
        MsgBox "File Nay Chua Mo", 64, "Thông Báo"
    End If
End Sub
 
Lần chỉnh sửa cuối:
bạn thử code sau nhớ sửa lại tên File và hai File phải cùng chung Folder
PHP:
Function IsFileOpen(FileName As String)
    Dim iFilenum As Long, iErr As Long
    On Error Resume Next
    iFilenum = FreeFile()
    Open FileName For Input Lock Read As #iFilenum
    Close iFilenum
    iErr = Err
    On Error GoTo 0
    Select Case iErr
        Case 0:    IsFileOpen = False
        Case 70:   IsFileOpen = True
        Case Else: Error iErr
    End Select
End Function
Chạy Sub này
PHP:
Sub CheckFile()
    Dim FileName As String
    FileName = ThisWorkbook.Path & "\B.xlsb"
    If IsFileOpen(FileName) Then
        MsgBox "File Dang Mo", 64, "Thông Báo"
    Else
        MsgBox "File Nay Chua Mo", 64, "Thông Báo"
    End If
End Sub
Mình chạy thử thì nó báo lỗi ở đoạn: Case Else: Error iErr (Lỗi File not found)
Hiện tại hình đang chạy đoạn Macro:
Sub Macro1()
'
' Macro1 Macro
'


'
ChDir "C:\Documents and Settings\Administrator\Desktop\New Folder"
Workbooks.Open FileName:= _
"C:\Documents and Settings\Administrator\Desktop\New Folder\B.xlsx"
Windows("A.xlsx").Activate
End Sub

Nó mở file B lên là xong nhiệm vụ. -> Mình thấy cách này đơn giản hơn khá nhiều. Hiện tại file mình chạy khá ổn.

Cảm ơn bạn rất nhiều. Nhưng với trình độ của mình chưa hiểu được hết được đoạn code của bạn.

Thân!
 
Web KT

Bài viết mới nhất

Back
Top Bottom