用Excel vba判断某个文件是否已经打开
请教大家，怎样用Excel vba判断某个dwg文件是否已经打开？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 于 2023-11-28 14:05 编辑
获取打开文档的所有名称，需要获取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 于 2024-5-22 14:06 编辑
'引用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 于 2023-11-28 17:32 编辑
liuhe 发表于 2023-11-28 14:03
获取打开文档的所有名称，需要获取CAD的appliction
谢谢您的帮助，效果不错。唯一美中不足的是必须在 工具--引用那里手工引用Autocad 2010类型库，我以前的是不需要的，有办法解决吗，类似的Excel文档很多（比如用代码取代这个过程） 尝试改名，改成功了就说明没被打开，当然要先排除无权限的情况。 mikewolf2k 发表于 2023-11-29 09:02
尝试改名，改成功了就说明没被打开，当然要先排除无权限的情况。
谢谢您的关注。不会写这个改名代码，能帮忙写下吗 sunny_8848 发表于 2023-11-28 17:27
谢谢您的帮助，效果不错。唯一美中不足的是必须在 工具--引用那里手工引用Autocad 2010类型库，我以 ...
不引用的话excel不认识这个类型啊没办法的，而且cad版本不同这个名称也不同，我cad2024是 AutoCAD 2021 Type Library
沙发的代码很经典，遍历类型msg显示名称
你可以自己改下适合自己匹配那个你需要判断的dwg文件名。
谢谢关注，已经放弃这个功能了 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文件是否已经打开的吗
任意文件不一定是excel文件啊
页:
[1]
2