Excel VBA调用DraftSight转换DWG为DXF时打开文件报错求助

核心错误点及修复方案 #

1. 未处理DraftSight未启动的情况 #

GetObject(, "DraftSight.Application")仅能获取已运行的DraftSight实例，如果DraftSight没打开，这行直接报错。需改为先尝试获取现有实例，失败则启动新实例：

On Error Resume Next
Set objApp = GetObject(, "DraftSight.Application")
If Err.Number <> 0 Then
    Set objApp = CreateObject("DraftSight.Application")
    objApp.Visible = True ' 可选：显示DraftSight界面，方便排查单个文件的问题
End If
On Error GoTo 0

2. DWG文件匹配逻辑有漏洞 #

Right(file.Name, 4) = ".dwg"无法匹配大写后缀（如.DWG），且文件名长度不足4时会报错。调整为：

If LCase(Right(file.Name, 4)) = ".dwg" And Len(file.Name) >= 4 Then

3. 未声明file变量 #

循环中的file变量未声明，会被当作变体类型，可能引发隐式错误。在代码开头添加：

Dim file As Object ' 对应FileSystemObject的File对象

4. 单个文件错误捕获 #

部分文件可能存在损坏、锁定情况，需添加错误捕获避免整个程序中断：

On Error Resume Next
Set objDoc = objApp.Documents.Open(file.Path)
If Err.Number = 0 Then
    objDoc.SaveAs Replace(file.Path, ".dwg", ".dxf"), 24
    objDoc.Close False
Else
    MsgBox "文件处理失败：" & file.Name & vbCrLf & Err.Description
End If
On Error GoTo 0

修复后的完整代码 #

Sub DWG2DXF()
    Dim folderPath As String
    Dim file As Object
    Dim objApp As Object
    Dim objDoc As Object
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Title = "选择目标文件夹"
        .InitialFileName = "C:\"
        If .Show = -1 Then
            folderPath = .SelectedItems(1)
        End If
    End With
    
    If folderPath <> "" Then
        ' 处理DraftSight实例：存在则获取，不存在则启动
        On Error Resume Next
        Set objApp = GetObject(, "DraftSight.Application")
        If Err.Number <> 0 Then
            Set objApp = CreateObject("DraftSight.Application")
            objApp.Visible = True
        End If
        On Error GoTo 0
        
        ' 遍历文件夹内的DWG文件
        For Each file In CreateObject("Scripting.FileSystemObject").GetFolder(folderPath).Files
            If LCase(Right(file.Name, 4)) = ".dwg" And Len(file.Name) >= 4 Then
                On Error Resume Next
                Set objDoc = objApp.Documents.Open(file.Path)
                If Err.Number = 0 Then
                    objDoc.SaveAs Replace(file.Path, ".dwg", ".dxf"), 24
                    objDoc.Close False
                Else
                    MsgBox "文件打开失败：" & file.Name & vbCrLf & "错误信息：" & Err.Description
                End If
                On Error GoTo 0
            End If
        Next file
        
        Set objDoc = Nothing
        Set objApp = Nothing
        MsgBox "所选文件夹内的DWG文件已全部转换为DXF格式。"
    Else
        MsgBox "未选择文件夹。"
    End If
End Sub

额外注意事项 #

• 确保DraftSight企业版已激活，且拥有目标文件夹的读写权限
• 转换前关闭所有正在编辑的DWG文件，避免文件锁定导致打开失败
• 参数24对应DXF R2010版本，若需其他版本可查阅DraftSight API调整枚举值

内容的提问来源于stack exchange，提问作者SRiddle