用Excel vba判断某个文件是否已经打开

sunny_8848

请教大家，怎样用Excel vba判断某个dwg文件是否已经打开？

nslove44202489

Function IsFileInUse(FileName As String) As Boolean
    Dim ff As Long, ErrNo As Long
    On Error Resume Next
    ff = FreeFile()
    Open FileName For Input Lock Read As #ff
    Close ff
    ErrNo = Err
    On Error GoTo 0
    Select Case ErrNo
        Case 0:
            IsFileInUse = False
        Case 70:
            IsFileInUse = True
        Case Else:
            Error ErrNo
    End Select
End Function

Public Sub CheckFileIsInuse()
     Dim fn As String
    fn = "D:\A.xlsx"
    If dir(fn) = vbNullString Then MsgBox fn & vbNewLine & "not found, please check", vbCritical + vbOKOnly: Exit Sub
    If IsFileInUse(fn) Then
        MsgBox fn & vbNewLine & "is open already", vbCritical + vbOKOnly: Exit Sub
    Else
        MsgBox fn & vbNewLine & "no body open this file", vbInformation + vbOKOnly:
    End If
End Sub

liuhe

获取打开文档的所有名称，需要获取CAD的appliction


Sub Example_Documents()
    ' This example obtains a reference to the Documents collection
    ' and displays information about the loaded documents.
'此示例获取对Documents集合的引用

'并显示有关已加载文档的信息。

    Dim Document As AcadDocument
    Dim msg As String
    msg = vbCrLf
   
    ' Cycle through the Documents collection and retrieve the names
    ' of the loaded documents
'循环浏览Documents集合并检索名称

'加载的文档

    For Each Document In Documents
        msg = msg & Document.name & vbCrLf
    Next
   
    ' Display loaded document information
'显示加载的文档信息
    If Documents.count > 0 Then
        MsgBox "The loaded documents are: " & msg
    Else
        MsgBox "There are no loaded documents!"
    End If
End Sub

wuyunpeng888

'引用FileSystemObject
Public Function IsOccupied(ByVal strFileName As String) As Boolean
Dim Fso As New FileSystemObject, strPath As String
strPath = Replace(LCase(strFileName), ".dwg", ".dw2")
If Fso.FileExists(strPath) = True Then
    Fso.DeleteFile strPath
    If Fso.FileExists(strPath) = True Then IsOccupied = True
End If
End Function

sunny_8848

liuhe 发表于 2023-11-28 14:03
获取打开文档的所有名称，需要获取CAD的appliction

谢谢您的帮助，效果不错。唯一美中不足的是必须在   工具--引用  那里手工引用Autocad 2010类型库，我以前的是不需要的，有办法解决吗，类似的Excel文档很多（比如用代码取代这个过程）

mikewolf2k

尝试改名，改成功了就说明没被打开，当然要先排除无权限的情况。

sunny_8848

mikewolf2k 发表于 2023-11-29 09:02
尝试改名，改成功了就说明没被打开，当然要先排除无权限的情况。

谢谢您的关注。不会写这个改名代码，能帮忙写下吗

szuki

sunny_8848 发表于 2023-11-28 17:27
谢谢您的帮助，效果不错。唯一美中不足的是必须在   工具--引用  那里手工引用Autocad 2010类型库，我以 ...

不引用的话excel不认识这个类型啊没办法的，而且cad版本不同这个名称也不同，我cad2024是 AutoCAD 2021 Type Library

沙发的代码很经典，遍历类型msg显示名称
你可以自己改下适合自己匹配那个你需要判断的dwg文件名。

sunny_8848

谢谢关注，已经放弃这个功能了

sunny_8848

nslove44202489 发表于 2024-4-13 20:45
Function IsFileInUse(FileName As String) As Boolean
    Dim ff As Long, ErrNo As Long
    On Error ...

谢谢帮忙。fn = "D:\A.xlsx"，您的代码是判断xlxs文件是否已经打开的吗

nslove44202489

任意文件不一定是excel文件啊