solidworks的VBA问题
我打的程序无法运行，有没有懂的人帮我看看！谢谢。Dim swapp As Object
Dim part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim pathstr As String
Dim fname(500) As String, fnum As Long
Sub main()
Dim i As Long
Dim pathstr0 As String, pathstr1 As String
Dim pathstr2 As String, pathstr3 As String, pathstr4 As String, pathstr5 As String
Dim L As Long, L1 As Long
pathstr = InputBox("请输入需要转的工程图所在位置")
Call Showfilelist(pathstr)
Set swapp = Application.SldWorks
For i = 0 To fnum - 1
pathstr0 = pathstr & "\" & fname(i)
Set part = swapp.OpenDoc6(pathstr0, 3, 0, "", longstatus, longwarnings)
L = Len(pathstr0)
pathstr1 = Left(pathstr0, L - 7) & ".DWG"
pathstr2 = Left(pathstr0, L - 7) & ".PDF"
longstatus = part.SaveAs3(pathstr1, 0, 0)
longstatus = part.SaveAs3(pathstr2, 0, 0)
Set part = Nothing
L1 = Len(fname(i))
pathstr3 = Left(fname(i), L1 - 7) & "- 图纸1"
pathstr4 = Left(fname(i), L1 - 7) & "- 图纸2"
pathstr5 = Left(fname(i), L1 - 7) & "- 图纸3"
swapp.colsedoc pathstr3
swapp.colsedoc pathstr4
swapp.colsedoc pathstr5
Next i
End Sub
Private Sub Showfilelist(folderspec As String)
Dim fs, f, f1, fc, s
Set fs = CreateObject("scripting,filesystemobject")
Set f = fs.getfolder(folderspec)
Set fc = f.files
fnum = 0
For Each fi In fc
If InStr(f1.Name, "slddrw") > 0 Then
fname(fnum) = f1.Name
fnum = fnum + 1
End If
Next
End Sub
Dim swapp As Object
Dim part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim pathstr As String
Dim fname(500) As String, fnum As Long
Sub main()
Dim i As Long
Dim pathstr0 As String, pathstr1 As String
Dim pathstr2 As String, pathstr3 As String, pathstr4 As String, pathstr5 As String
Dim L As Long, L1 As Long
pathstr = InputBox("请输入需要转换的工程图所在位置")
Call Showfilelist(pathstr)
Set swapp = Application.SldWorks
For i = 0 To fnum - 1
pathstr0 = pathstr & "\" & fname(i)
Set part = swapp.OpenDoc6(pathstr0, 3, 0, "", longstatus, longwarnings)
L = Len(pathstr0)
pathstr1 = Left(pathstr0, L - 7) & ".DWG"
pathstr2 = Left(pathstr0, L - 7) & ".PDF"
longstatus = part.SaveAs3(pathstr1, 0, 0)
longstatus = part.SaveAs3(pathstr2, 0, 0)
swapp.CloseDoc pathstr0
Next i
End Sub
Private Sub Showfilelist(folderspec As String)
Dim fs, f, f1, fc, s
Set fs = CreateObject("Scripting.filesystemobject")
Set f = fs.getfolder(folderspec)
Set fc = f.files
fnum = 0
For Each f1 In fc
If InStr(UCase(f1.Name), "SLDDRW") > 0 Then
fname(fnum) = f1.Name
fnum = fnum + 1
End If
Next
End Sub
本帖最后由 steve_suich 于 2023-4-25 09:10 编辑
swapp.colsedoc 应为swapp.closedoc
Scripting,filesystemobject应为Scripting.filesystemobject
判断slddrw时，应先全部转换为大写，再进行判断。
steve_suich 发表于 2023-4-25 09:07
swapp.colsedoc 应为swapp.closedoc
Scripting,filesystemobject应为Scripting.filesystemobject
判断sld ...
谢谢。
页:
[1]