solidworks的VBA问题

dajian1984

我打的程序无法运行，有没有懂的人帮我看看！谢谢。
* W5 @7 {) ^0 h# J
Dim swapp As Object
Dim part As Object
Dim boolstatus As Boolean
' ]+ r/ G# o. u; N( @2 @. EDim longstatus As Long, longwarnings As Long
) j# \( z, q  zDim pathstr As String
( U/ B' s  @! Z' ^1 g  l+ t" RDim fname(500) As String, fnum As Long
Sub main()
Dim i As Long
Dim pathstr0 As String, pathstr1 As String
& ?, k/ q. ]$ M. E2 F$ U! fDim pathstr2 As String, pathstr3 As String, pathstr4 As String, pathstr5 As String
& A5 K8 A% p9 P' u! G; nDim L As Long, L1 As Long
pathstr = InputBox("请输入需要转的工程图所在位置")
Call Showfilelist(pathstr)
Set swapp = Application.SldWorks
$ u% k2 e# e" ?" H
For i = 0 To fnum - 1
pathstr0 = pathstr & "\" & fname(i)

Set part = swapp.OpenDoc6(pathstr0, 3, 0, "", longstatus, longwarnings)
( U8 K& Y2 _9 {; Z" f
L = Len(pathstr0)

. R, o6 n! ^$ t& spathstr1 = Left(pathstr0, L - 7) & ".DWG"
2 t$ k' Q% S- }) S$ E
! Y/ a0 k* b1 E0 y8 i" q  xpathstr2 = Left(pathstr0, L - 7) & ".PDF"

, a2 U& w& [# B: Y' g* C% llongstatus = part.SaveAs3(pathstr1, 0, 0)

' a- n$ Q" r0 ~! O0 v- W5 C+ Ylongstatus = part.SaveAs3(pathstr2, 0, 0)

Set part = Nothing
6 v$ |$ g7 Z+ v- X: f- h4 G
L1 = Len(fname(i))
- ]3 L& r5 q4 ]8 m2 C: P9 H
pathstr3 = Left(fname(i), L1 - 7) & "- 图纸1"
; I" e) r1 e" J9 a1 s, ~
+ x5 |2 {3 j2 w& ppathstr4 = Left(fname(i), L1 - 7) & "- 图纸2"

9 z* k9 ~/ }4 c/ Fpathstr5 = Left(fname(i), L1 - 7) & "- 图纸3"
% z0 g' Y- y8 g# @5 I7 W  j) O0 H
swapp.colsedoc pathstr3

, I2 o* F" R4 Qswapp.colsedoc pathstr4
0 |9 j9 \, {. ?, T5 q6 b
swapp.colsedoc pathstr5
" a) E4 ^9 c. j$ I; E
Next i


End Sub

" g! V) d4 J' f* ?; g& O* E, F( f
Private Sub Showfilelist(folderspec As String)
: L2 v" e/ s( ^, i' b8 \
' p, B! P& j. g5 h7 T
8 w; f8 U8 y0 ~4 LDim fs, f, f1, fc, s
& H, ^% T2 U, e/ h7 V- C7 R5 S% c
Set fs = CreateObject("scripting,filesystemobject")
* C1 T) q0 K0 l3 L
0 [/ i# V  |1 SSet f = fs.getfolder(folderspec)
: p/ O* y1 e2 ^/ A1 H
5 f8 T( y% D, I( E$ E" Z' R& a& ]Set fc = f.files

fnum = 0
4 c9 M- a1 t& ~* I" v9 `
  L/ ]' u3 y' ~9 ?- E0 V3 MFor Each fi In fc

If InStr(f1.Name, "slddrw") > 0 Then
* R+ l4 ^' m, a$ E6 C5 \
fname(fnum) = f1.Name

fnum = fnum + 1

End If
4 I8 H% X1 m1 M: _) N
! C; }% K' ]1 P; H& u. H# M' c% SNext

End Sub

steve_suich

1. Dim swapp As Object
   
2. Dim part As Object
   & b1 q* o! T$ t
3. Dim boolstatus As Boolean
   / _4 ~* M2 g& Y8 R: S3 h; T
4. Dim longstatus As Long, longwarnings As Long
   8 \1 t5 A4 l, H& U' H
5. Dim pathstr As String
   5 @+ j9 ^8 l7 \" D8 P7 [8 }
6. Dim fname(500) As String, fnum As Long
   
7. Sub main()
   
8. Dim i As Long
   * x- i9 H  |$ O8 Y6 c" l
9. Dim pathstr0 As String, pathstr1 As String
   
10. Dim pathstr2 As String, pathstr3 As String, pathstr4 As String, pathstr5 As String
    : G  u5 q+ s0 U' e# G" P) [
11. Dim L As Long, L1 As Long
    
12. pathstr = InputBox("请输入需要转换的工程图所在位置")
    
13. Call Showfilelist(pathstr)
    
14. Set swapp = Application.SldWorks
    
15. 
    0 D! F" i; h/ q& d
16. For i = 0 To fnum - 1
    8 G/ [3 }" M7 m3 \
17. pathstr0 = pathstr & "" & fname(i)
    % B. @$ _7 U2 w( h6 I, a) N
18. 
    / C; _- k+ u, g0 n
19. Set part = swapp.OpenDoc6(pathstr0, 3, 0, "", longstatus, longwarnings)
    
20. L = Len(pathstr0)
    
21. 
    " H/ X( _6 s: Y9 E8 k. u4 h; l
22. pathstr1 = Left(pathstr0, L - 7) & ".DWG"
    5 R, v) T4 @, \- U  }7 w
23. 
    
24. pathstr2 = Left(pathstr0, L - 7) & ".PDF"
    8 l6 e1 G& {, T# }% t
25. 
    
26. longstatus = part.SaveAs3(pathstr1, 0, 0)
    
27. longstatus = part.SaveAs3(pathstr2, 0, 0)
    
28. 
    
29. swapp.CloseDoc pathstr0
    - u5 d5 P! C: N1 d+ T
30. 
    % C' T! }; A# T: j" z6 t
31. Next i
    
32. 
    
33. End Sub
    
34. 
    & S* s+ h. w$ u# M+ X8 ~/ A
35. Private Sub Showfilelist(folderspec As String)
    
36. Dim fs, f, f1, fc, s
    
37. 
    . P8 u7 c+ B4 C5 s# a& A
38. Set fs = CreateObject("Scripting.filesystemobject")
    1 L7 R  E6 ]' s6 \( a
39. 
    
40. Set f = fs.getfolder(folderspec)
    $ K- j5 R5 f0 f' @( s; V
41. 
    : Q5 f4 \, }/ V
42. Set fc = f.files
    1 R8 T2 d3 n; }$ }
43. 
    . Q7 J/ Q) @3 p# O! f7 q  {
44. fnum = 0
    / g1 X2 ?7 F3 P; }! I- n( C& n/ B7 g% q
45. 
    + ~- k  I: f1 f
46. For Each f1 In fc
    2 r5 @3 C8 R/ }4 @$ I, W
47. If InStr(UCase(f1.Name), "SLDDRW") > 0 Then
    + q2 ?+ _  ^9 T1 k; p* ]9 p2 B/ D1 _
48. fname(fnum) = f1.Name
    - M- c8 u4 T1 l9 f
49. fnum = fnum + 1
    + A1 H  S6 Q' d" e
50. 
    ! k( g' \+ p& ?! `+ x3 v7 C  s8 G" Q
51. End If
    
52. 
    
53. Next
    - Z% Z3 L& q6 |/ D
54. 
    
55. End Sub
    

复制代码

. Z) l( n6 D: S) ^- P
1 z+ Z- }/ t& K0 c$ V

steve_suich

swapp.colsedoc 应为swapp.closedoc
" Y: Q$ J* o! V4 E5 yScripting,filesystemobject应为Scripting.filesystemobject
: V$ _3 t. ]/ N判断slddrw时，应先全部转换为大写，再进行判断。

dajian1984

steve_suich 发表于 2023-4-25 09:07
# C4 a, f4 s: ^% k2 k7 w! Pswapp.colsedoc 应为swapp.closedoc
Scripting,filesystemobject应为Scripting.filesystemobject
判断sld ...

. U( V1 S! ?, j0 W$ V5 j: _/ ~谢谢。
+ v8 C* n! h1 I  F" T1 a) E