solidworks的VBA问题

dajian1984

我打的程序无法运行，有没有懂的人帮我看看！谢谢。
  `: W( ]' R! a4 U% ?
Dim swapp As Object
+ f1 k4 ~& j' a1 `! w% Y- TDim part As Object
8 F4 p5 U# x1 tDim boolstatus As Boolean
% X( u  X) b, P! \; FDim longstatus As Long, longwarnings As Long
" h2 T" u5 s3 rDim pathstr As String
Dim fname(500) As String, fnum As Long
Sub main()
Dim i As Long
) k" Y- E- m& F6 G, ~5 Z) m, ^Dim pathstr0 As String, pathstr1 As String
. n( W8 G0 x+ g' j( `/ EDim pathstr2 As String, pathstr3 As String, pathstr4 As String, pathstr5 As String
Dim L As Long, L1 As Long
  N+ r9 f5 K- ]8 m# fpathstr = InputBox("请输入需要转的工程图所在位置")
8 q3 Z7 \: ]. {8 k) l% xCall Showfilelist(pathstr)
Set swapp = Application.SldWorks
& D* {+ i1 S/ u
6 U0 v3 m, C7 \/ F8 X2 n3 u  _+ yFor i = 0 To fnum - 1
/ V" @0 x' W, c) c- r' npathstr0 = pathstr & "\" & fname(i)

% E/ @. ~, n, h- {; g; Q; v) CSet part = swapp.OpenDoc6(pathstr0, 3, 0, "", longstatus, longwarnings)
; l- T) g7 x) p4 W
: }1 u* L6 a2 Y- J1 KL = Len(pathstr0)

3 {. C. y" e& @pathstr1 = Left(pathstr0, L - 7) & ".DWG"

0 W7 a9 x$ X8 k7 \3 `" D) A7 wpathstr2 = Left(pathstr0, L - 7) & ".PDF"
1 d# R! w+ j5 X) a/ j  |$ x& j# A, l
8 g1 r0 a- W. v2 W+ glongstatus = part.SaveAs3(pathstr1, 0, 0)
$ @# t% C! I3 p  Y  x5 l) [3 P
longstatus = part.SaveAs3(pathstr2, 0, 0)
5 o- E. r' ]9 Z; d
Set part = Nothing

% u- E' H6 z; R# o9 n7 p6 cL1 = Len(fname(i))

pathstr3 = Left(fname(i), L1 - 7) & "- 图纸1"
0 e( a& m1 Q2 U. J
& t1 ~3 k" _4 l$ R/ u/ Ppathstr4 = Left(fname(i), L1 - 7) & "- 图纸2"

+ J/ I2 A, C# J! m" vpathstr5 = Left(fname(i), L1 - 7) & "- 图纸3"

swapp.colsedoc pathstr3
/ ?! y  y7 P# [5 V6 Z% d( W% f
swapp.colsedoc pathstr4

* j# c  `( \( b8 o1 L- e: a8 W% Mswapp.colsedoc pathstr5

Next i
/ H" z# h; [: @

End Sub

/ Z# ~2 d& v3 f; Q
Private Sub Showfilelist(folderspec As String)

% c2 Z5 k3 i; a
. s, g! E+ \* ?- s; L; yDim fs, f, f1, fc, s

* U7 O0 E; |0 q: g/ U8 g+ uSet fs = CreateObject("scripting,filesystemobject")

  L9 {: F, V5 O7 [9 Y- DSet f = fs.getfolder(folderspec)

, }( ]1 w- \' W$ e4 q+ z' Q& v- KSet fc = f.files

+ T) P2 k# p4 P3 y' W3 rfnum = 0

For Each fi In fc
- l- d& d' X  y9 m" M. c
If InStr(f1.Name, "slddrw") > 0 Then

5 {: D5 ^* ~! o( w- M: lfname(fnum) = f1.Name

fnum = fnum + 1

End If

Next

- E- G! k6 R( l2 m7 X' wEnd Sub
4 N5 V8 [' |; e( O# ]3 ?6 ~

steve_suich

1. Dim swapp As Object
   
2. Dim part As Object
   
3. Dim boolstatus As Boolean
   
4. Dim longstatus As Long, longwarnings As Long
   
5. Dim pathstr As String
   # Y3 _' y8 X- _/ _7 _6 b- e2 M! w4 x
6. Dim fname(500) As String, fnum As Long
   + H( M0 \; K! q8 W" E. W: A
7. Sub main()
   ' A& L0 a: N/ i; n6 D- [
8. Dim i As Long
   
9. Dim pathstr0 As String, pathstr1 As String
   
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)
    ( A$ o& _* h. b+ J# K) B- g
14. Set swapp = Application.SldWorks
    1 |3 ]1 G$ P- b8 f4 ^/ g$ A/ G
15. 
    4 r* t- q/ b/ y8 u" q& M& e
16. For i = 0 To fnum - 1
      D. f7 u- ^* m. \( V$ n
17. pathstr0 = pathstr & "" & fname(i)
    
18. 
    
19. Set part = swapp.OpenDoc6(pathstr0, 3, 0, "", longstatus, longwarnings)
    
20. L = Len(pathstr0)
    
21. 
    0 u( F" s( }' @: D1 X4 f( L$ {
22. pathstr1 = Left(pathstr0, L - 7) & ".DWG"
    & B  d! @6 k$ k( T# _
23. 
    / j7 y$ w+ m3 k& g+ d
24. pathstr2 = Left(pathstr0, L - 7) & ".PDF"
    " u# s$ _! x$ }7 e# B$ K
25. 
    
26. longstatus = part.SaveAs3(pathstr1, 0, 0)
    : z( A7 @9 e, W# e! j3 c$ ~
27. longstatus = part.SaveAs3(pathstr2, 0, 0)
    # c3 g1 H* d& n! t. s
28. 
    + d" r) _, I: a; H
29. swapp.CloseDoc pathstr0
    
30. 
    
31. Next i
      m! q! u. U/ v5 B/ c, P# ]& P
32. 
    1 |4 \. K! @! T6 F: P
33. End Sub
    - y9 Z3 a( `+ B$ S1 R! g. x- I* `
34. 
    3 n3 L/ [3 [9 q2 `. e
35. Private Sub Showfilelist(folderspec As String)
    4 l& b/ j" u, W( J* D
36. Dim fs, f, f1, fc, s
    
37. 
      k4 M: M2 I% i: N6 a. H
38. Set fs = CreateObject("Scripting.filesystemobject")
    
39. 
    3 W( r* f; }$ B. |; d  n
40. Set f = fs.getfolder(folderspec)
    
41. 
    + I( Q) ~  Y# B
42. Set fc = f.files
    
43. 
    
44. fnum = 0
    
45. 
    6 j3 F1 Z0 H6 N4 j
46. For Each f1 In fc
    
47. If InStr(UCase(f1.Name), "SLDDRW") > 0 Then
    ; S0 v$ \0 k( {5 a$ i% I* d1 P: I
48. fname(fnum) = f1.Name
    
49. fnum = fnum + 1
    
50. 
    3 I  E  R) Z& z
51. End If
    
52. 
    
53. Next
    
54. 
    4 C7 i  ^: ?  z$ Y; M
55. End Sub
    8 E% z; ~* k2 h& {% B. ^9 @

复制代码

* q; p* X& W  N% p: `
* `8 L/ n* [! Z1 }

steve_suich

" N5 q0 B  V. T; U
1 d: E- A0 n/ ?) m; C! }% a* u' [swapp.colsedoc 应为swapp.closedoc
Scripting,filesystemobject应为Scripting.filesystemobject
判断slddrw时，应先全部转换为大写，再进行判断。
' Q8 O1 f* D6 W: M

dajian1984

steve_suich 发表于 2023-4-25 09:07
8 [: W6 _' `7 @! v/ ~swapp.colsedoc 应为swapp.closedoc
* g6 u% v; @! }! S: `) EScripting,filesystemobject应为Scripting.filesystemobject
4 S; ^& [. z! w3 r: w5 ^8 i判断sld ...

) F# o4 [/ F( T% G$ N谢谢。