无人值守 批处理:批量工程图转PDF(SolidWorks 宏工具)

==== 开始导出 ====源目录：C:\Users\DR\Desktop\Electronics Enclosure覆盖成功：C:\Users\DR\Desktop\Electronics Enclosure\Base1.pdf覆盖成功：C:\Users\DR\Desktop\Electronics Enclosure\Cap.pdf覆盖成功：C:\Users\DR\Desktop\Electronics Enclosure\Chip.pdf覆盖成功：C:\Users\DR\Desktop\Electronics Enclosure\Cover.pdf覆盖成功：C:\Users\DR\Desktop\Electronics Enclosure\PCB.pdf==== 完成 ====总数：5成功：5失败：0

Option Explicit' ============================================================' DR-SW Tools | 批量工程图导出 PDF' ============================================================Const swDocDRAWING As Long = 3Const swOpenDocOptions_Silent As Long = 1Const swSaveAsOptions_Silent As Long = 1Const swSaveAsCurrentVersion As Long = 0Dim swApp As SldWorks.SldWorksDim gTotalCount As LongDim gSuccessCount As LongDim gFailCount As LongDim gSourceFolder As StringDim gOutputFolder As StringDim gUseSeparateOutputFolder As BooleanDim gIncludeSubFolders As BooleanDim gLog As StringDim gLogFilePath As StringSub BatchDrawingsToPDF_Auto()    On Error GoTo EH    Set swApp = Application.SldWorks    ' ===== 选择源文件夹 =====    gSourceFolder = BrowseForFolder("请选择工程图文件夹")    If gSourceFolder = "" Then Exit Sub    ' ===== 是否递归 =====    gIncludeSubFolders = (MsgBox("是否递归子文件夹？", vbYesNo) = vbYes)    ' ===== 输出方式 =====    gUseSeparateOutputFolder = (MsgBox("是否导出到单独文件夹？", vbYesNo) = vbYes)    If gUseSeparateOutputFolder Then        gOutputFolder = BrowseForFolder("请选择输出文件夹")        If gOutputFolder = "" Then Exit Sub    Else        gOutputFolder = gSourceFolder    End If    ' ===== 初始化 =====    gTotalCount = 0    gSuccessCount = 0    gFailCount = 0    gLog = ""    gLogFilePath = gOutputFolder & "\PDF_Export_Log_" & Format(Now, "yyyymmdd_HHNNSS") & ".txt"    AppendLog "==== 开始导出 ===="    AppendLog "源目录：" & gSourceFolder    ProcessFolder gSourceFolder    AppendLog "==== 完成 ===="    AppendLog "总数：" & gTotalCount    AppendLog "成功：" & gSuccessCount    AppendLog "失败：" & gFailCount    WriteTextFile gLogFilePath, gLog    MsgBox "完成！成功：" & gSuccessCount & " 失败：" & gFailCount    Exit SubEH:    MsgBox "错误：" & Err.DescriptionEnd SubPrivate Sub ProcessFolder(folderPath As String)    Dim fso As Object, f, subF    Set fso = CreateObject("Scripting.FileSystemObject")    For Each f In fso.GetFolder(folderPath).Files        If LCase(fso.GetExtensionName(f.Name)) = "slddrw" Then            gTotalCount = gTotalCount + 1            ExportPDF f.path        End If    Next    If gIncludeSubFolders Then        For Each subF In fso.GetFolder(folderPath).SubFolders            ProcessFolder subF.path        Next    End IfEnd SubPrivate Sub ExportPDF(drwPath As String)    On Error GoTo EH    Dim fso As Object    Set fso = CreateObject("Scripting.FileSystemObject")    Dim swModel As SldWorks.ModelDoc2    Dim errors As Long, warnings As Long    Dim pdfPath As String    Dim fileName As String    fileName = fso.GetBaseName(drwPath) & ".pdf"    If gUseSeparateOutputFolder Then        pdfPath = gOutputFolder & "\" & fileName    Else        pdfPath = fso.GetParentFolderName(drwPath) & "\" & fileName    End If    ' ===== 打开 =====    Set swModel = swApp.OpenDoc6(drwPath, swDocDRAWING, swOpenDocOptions_Silent, "", errors, warnings)    If swModel Is Nothing Then        gFailCount = gFailCount + 1        AppendLog "打开失败：" & drwPath        Exit Sub    End If    ' ===== 直接覆盖保存 =====    Dim ok As Boolean    ok = swModel.Extension.SaveAs(pdfPath, swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, 0, 0)    swApp.CloseDoc swModel.GetTitle    If ok Then        gSuccessCount = gSuccessCount + 1        AppendLog "覆盖成功：" & pdfPath    Else        gFailCount = gFailCount + 1        AppendLog "导出失败：" & drwPath    End If    Exit SubEH:    gFailCount = gFailCount + 1    AppendLog "异常：" & drwPath & " | " & Err.DescriptionEnd SubPrivate Function BrowseForFolder(title As String) As String    Dim sh, f    Set sh = CreateObject("Shell.Application")    Set f = sh.BrowseForFolder(0, title, 0, 0)    If Not f Is Nothing Then BrowseForFolder = f.Self.pathEnd FunctionPrivate Sub WriteTextFile(path As String, content As String)    Dim fso, ts    Set fso = CreateObject("Scripting.FileSystemObject")    Set ts = fso.CreateTextFile(path, True)    ts.Write content    ts.CloseEnd SubPrivate Sub AppendLog(txt As String)    If gLog = "" Then        gLog = txt    Else        gLog = gLog & vbCrLf & txt    End IfEnd Sub