|
- Option Explicit
- Sub SaveAllSLDDRWFiles()
- Dim swApp As Object
- Dim swModel As ModelDoc2
- Dim swDraw As DrawingDoc
- Dim FolderPath As String
- Dim FileName As String
- Dim FilePath As String
- Dim FSO As Object
- Dim Folder As Object
- Dim File As Object
-
- ' 获取SolidWorks应用程序对象
- Set swApp = Application.SldWorks
-
- ' 弹出对话框选择文件夹
- With Application.FileDialog(msoFileDialogFolderPicker)
- .Title = "选择包含.SLDDRW文件的文件夹"
- If .Show = -1 Then
- FolderPath = .SelectedItems(1)
- Else
- MsgBox "未选择任何文件夹,程序将退出。", vbExclamation
- Exit Sub
- End If
- End With
-
- ' 创建文件系统对象
- Set FSO = CreateObject("Scripting.FileSystemObject")
-
- ' 获取文件夹中的所有文件
- Set Folder = FSO.GetFolder(FolderPath)
-
- ' 遍历文件夹中的每个文件
- For Each File In Folder.Files
- ' 检查文件扩展名是否为.SLDDRW
- If UCase(FSO.GetExtensionName(File.Name)) = "SLDDRW" Then
- FilePath = File.Path
- Set swModel = swApp.OpenDoc6(FilePath, swDocDRAWING, swOpenDocOptions_Silent, "", 0, 0)
-
- If Not swModel Is Nothing Then
- ' 保存文件
- swModel.Save
-
- ' 关闭文件
- swApp.CloseDoc swModel.GetTitle
- End If
- End If
- Next File
-
- ' 处理完毕后提示
- MsgBox "所有文件已保存完毕!", vbInformation
- End Sub
复制代码 |
|