,

I want to assemble all the .sldprt files in a folder, but I can only create a new assembly, and the parts are not being added.

Where is the mistake?

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim swAssy As SldWorks.ModelDoc2
Dim swAsm As SldWorks.AssemblyDoc

Sub main()

   Dim folder As String
   Dim file As String
   Dim compX As Double: compX = 0#
   Dim compY As Double: compY = 0#
   Dim compZ As Double: compZ = 0#
   
   Set swApp = Application.SldWorks
   Dim value As Component2
   
   '===== フォルダ選択 =====
   folder = BrowseForFolder("部品ファイルが入ったフォルダを選択してください")
   If folder = "" Then
       MsgBox "キャンセルされました"
       Exit Sub
   End If
   
   '===== 新規アセンブリ作成 =====
   Dim swAsm As AssemblyDoc
   Set swAssy = swApp.NewDocument(swApp.GetUserPreferenceStringValue(swUserPreferenceStringValue_e.swDefaultTemplateAssembly), 0, 0, 0)
   'Set swAsm = swAssy
  Set swAsm = swApp.ActiveDoc
   
   '===== フォルダ内の *.sldprt を順に挿入 =====
   file = Dir(folder & "\\" & "*.sldprt")
   
   If file = "" Then
       MsgBox "フォルダ内に .sldprt がありません"
       Exit Sub
   End If
   
   Do While file <> ""
       Dim fullPath As String
       fullPath = folder & "\\" & file
       
       '部品を配置
       Set value = swAsm.AddComponent5(fullPath, 0, "", False, "", compX, compY, compZ)

       
       '少しずらして配置（重なり防止）
       'compX = compX + 0.1
       
       file = Dir()
   Loop
   
   MsgBox "アセンブリを作成しました。名前を付けて保存してください。", vbInformation

End Sub

'===============フォルダ選択関数===============
Function BrowseForFolder(title As String) As String
   Dim sh As Object
   Dim folder As Object
   Set sh = CreateObject("Shell.Application")
   Set folder = sh.BrowseForFolder(0, title, 0, 0)
   If folder Is Nothing Then
       BrowseForFolder = ""
   Else
       BrowseForFolder = folder.Items().Item().Path
   End If
End Function