solidworks的VBA问题

dajian1984

我打的程序无法运行，有没有懂的人帮我看看！谢谢。

Dim swapp As Object
Dim part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim pathstr As String
7 S: }  t' N5 ~" kDim fname(500) As String, fnum As Long
6 W# `  ^4 j6 z# b- q! VSub main()
; Z+ y1 f1 B5 n% k" ]Dim i As Long
Dim pathstr0 As String, pathstr1 As String
5 g" o% d: g/ @! l7 C7 @$ gDim pathstr2 As String, pathstr3 As String, pathstr4 As String, pathstr5 As String
. o& S2 s& p( CDim L As Long, L1 As Long
0 n1 c, H; S5 I$ }  Xpathstr = InputBox("请输入需要转的工程图所在位置")
Call Showfilelist(pathstr)
Set swapp = Application.SldWorks

For i = 0 To fnum - 1
' P7 B" E' ~5 J' k) n3 o$ Epathstr0 = pathstr & "\" & fname(i)

Set part = swapp.OpenDoc6(pathstr0, 3, 0, "", longstatus, longwarnings)
$ O$ m' |4 M9 J) x# q! I
L = Len(pathstr0)
  V0 V- C+ T  y; o/ N5 R
  m. F( L0 Q8 @  w! |: J  apathstr1 = Left(pathstr0, L - 7) & ".DWG"

pathstr2 = Left(pathstr0, L - 7) & ".PDF"

! i7 z, ^2 Y* K' q* e& clongstatus = part.SaveAs3(pathstr1, 0, 0)

% F7 M6 I5 U1 |$ b5 p, W7 clongstatus = part.SaveAs3(pathstr2, 0, 0)
! A- j% Z9 B4 o7 ]7 b
Set part = Nothing

L1 = Len(fname(i))
% N4 a* ^! b% {$ R0 ~
! E- J2 ^- q% n, h3 @pathstr3 = Left(fname(i), L1 - 7) & "- 图纸1"

pathstr4 = Left(fname(i), L1 - 7) & "- 图纸2"
0 Q* i0 D+ a6 N" f) Z1 H. n: O
7 }! B0 @+ e1 e9 P' D- hpathstr5 = Left(fname(i), L1 - 7) & "- 图纸3"
6 }& k8 P: S9 }
swapp.colsedoc pathstr3

" |3 z6 i7 v4 H3 j/ k- ^% Jswapp.colsedoc pathstr4
+ \5 r  I  e# t  V
swapp.colsedoc pathstr5
  J" o4 }  V' a" f
Next i
$ E' s6 A/ m! {' o

1 S( f) ?. G+ Y5 l, n. X. aEnd Sub
8 _$ W5 |  u1 T1 k3 ?
" B1 Q0 g2 ?( G) w4 d
Private Sub Showfilelist(folderspec As String)
7 o+ F3 u# j( d9 Q

1 |4 |& u0 c0 IDim fs, f, f1, fc, s
) I  ~; _' j+ A5 @
% i% J  u8 u+ Y2 T% ^, ~5 \+ z5 @- pSet fs = CreateObject("scripting,filesystemobject")
1 u+ [' r. d3 ~
* U* a* m0 \! GSet f = fs.getfolder(folderspec)

Set fc = f.files

% l: |* O$ e/ t* Ifnum = 0

For Each fi In fc
  u$ K) ?; c- w# S. c% i& S
If InStr(f1.Name, "slddrw") > 0 Then

fname(fnum) = f1.Name
1 Y5 u" p1 `8 f! ?
1 G' D2 p- M  ?" Q- rfnum = fnum + 1
( S& Q$ P  D2 b" {
  `4 m3 D7 W# NEnd If
* y% {* f2 E7 f& V, g( f' U1 s0 E
  I2 E8 n- k0 MNext

End Sub

steve_suich

1. Dim swapp As Object
   
2. Dim part As Object
   
3. Dim boolstatus As Boolean
   6 Z( X! ]  ]. f$ H, Q. S# t% q# \
4. Dim longstatus As Long, longwarnings As Long
   + L- O9 \& V" ?& f# N0 ^$ J
5. Dim pathstr As String
   
6. Dim fname(500) As String, fnum As Long
   
7. Sub main()
   0 W. T; I. a& E8 v# T2 ?
8. Dim i As Long
   6 c1 q: a/ T' w7 K( j
9. Dim pathstr0 As String, pathstr1 As String
   " g- T5 P' E# `" P) O7 J
10. Dim pathstr2 As String, pathstr3 As String, pathstr4 As String, pathstr5 As String
    
11. Dim L As Long, L1 As Long
    
12. pathstr = InputBox("请输入需要转换的工程图所在位置")
    
13. Call Showfilelist(pathstr)
    
14. Set swapp = Application.SldWorks
    1 s2 T0 c' P" r9 V5 W  U6 S; h" E
15. 
    . b: K+ \# b# r5 C0 U! T# E$ ]
16. For i = 0 To fnum - 1
    % f6 N; X3 i. G9 h
17. pathstr0 = pathstr & "" & fname(i)
    
18. 
    ) ]  n2 x1 p/ l- x
19. Set part = swapp.OpenDoc6(pathstr0, 3, 0, "", longstatus, longwarnings)
    
20. L = Len(pathstr0)
    
21. 
    ! t8 U/ g' F0 K' |! K2 J
22. pathstr1 = Left(pathstr0, L - 7) & ".DWG"
      o& J1 Z9 T& {5 d- h
23. 
    
24. pathstr2 = Left(pathstr0, L - 7) & ".PDF"
    
25. 
    3 C/ g% L* H% t1 V" t
26. longstatus = part.SaveAs3(pathstr1, 0, 0)
    
27. longstatus = part.SaveAs3(pathstr2, 0, 0)
    % L$ n' ^9 }! z7 l. A7 R; x
28. 
    
29. swapp.CloseDoc pathstr0
    ; s8 H9 N+ ?+ b
30. 
    
31. Next i
    + P& S+ r/ u9 p5 Y  \) X/ `
32. 
    
33. End Sub
    3 Z/ f- }# x  K5 h
34. 
    
35. Private Sub Showfilelist(folderspec As String)
    
36. Dim fs, f, f1, fc, s
    
37. 
      }3 e" ^3 c' {. _" v
38. Set fs = CreateObject("Scripting.filesystemobject")
    
39. 
    , m/ T! y2 w; b  v
40. Set f = fs.getfolder(folderspec)
    / K  ?$ W+ U! W: g  E
41. 
    1 C* G' Y1 r) R* l0 a- M) O! z
42. Set fc = f.files
    " d; _! }1 W) E, _, t! _3 b0 e
43. 
    
44. fnum = 0
    
45. 
    ; m5 b7 t4 R# f9 ]
46. For Each f1 In fc
    1 z: U' R5 z) l6 g) u( `( A
47. If InStr(UCase(f1.Name), "SLDDRW") > 0 Then
    # q7 p  [! G9 j5 [2 N6 c
48. fname(fnum) = f1.Name
    
49. fnum = fnum + 1
    3 Y! t, L. b" D9 `* r" k5 N+ u% Z7 C
50. 
    
51. End If
    
52. 
    + H- Q6 m& W% Z  z! s( g
53. Next
    " @$ Q6 N" u+ D1 V- ^& A
54. 
    ! g9 |7 }( @; q1 w. _: D
55. End Sub
    

复制代码

+ Z( A. q! h: C+ X! l( C# f

steve_suich

# {( e' b  O9 X+ w2 n
swapp.colsedoc 应为swapp.closedoc
$ Q, \+ b* `& v+ H, z. `Scripting,filesystemobject应为Scripting.filesystemobject
8 q% U+ u& m& G; J2 s* @) e判断slddrw时，应先全部转换为大写，再进行判断。

dajian1984

steve_suich 发表于 2023-4-25 09:07
swapp.colsedoc 应为swapp.closedoc
Scripting,filesystemobject应为Scripting.filesystemobject
' w- S' {/ h6 H9 n5 M& U判断sld ...

8 R3 z- g5 Y5 `( L: B% ]( Y谢谢。