VBA add drawings to list

[russell84]

I'm creating a vba to batch change attributes in drawing title blocks.

 

Can someone help me with the actual from to set it up so there is a method of adding drawings to a list to be edited.

 

What does everyone use to do this??

 

Thanks

[BIGAL]

You could do it via a script in simple description

 

open dwg1 vbarun myprog close Y

open dwg2 vbarun myprog close Y

open dwg3 vbarun myprog close Y

[russell84]

Thanks Al

 

Though i'd really like to be able to add drawings to a list in a vba dialog box..

 

I've set up the dialog box as per the attached image.

I just need to know how i can use the add button to select drawings then add them to the list to be edited.

i mean im after some code to do this.

 

Cheers

[borgunit]

Adda common dialog object to your form and then this will browse to the folder and return it to a string variable txtOpenPath

 

Dim objCD As New FileDialog
   Dim objFileSystem As Scripting.FileSystemObject
   Dim objFile As Scripting.File
   Dim sFile As String
   '''''''''''''''''''''''''''''''''''''''
   With objCD
       .Filter = "Drawing (*.dwg)|*.dwg"
       .Title = "Choose a File in directory to be converted"
       .OwnerHwnd = 0&
       '.MultiSelect = 1
   End With
   
   Set objFileSystem = New Scripting.FileSystemObject
   sFile = objCD.ShowOpen
   Set objFile = objFileSystem.GetFile(sFile)
   txtOpenPath = objFile.ParentFolder
   Set objFile = Nothing
   Set objFileSystem = Nothing
   Set objCD = Nothing
   Exit Sub

 

I then call this to fill my list box full of files

 

Public Function FindFile( _
ByVal sFol As String, _
ByVal sFile As String, _
ByVal iDirs As Integer, _
ByVal iFiles As Integer, _
ByVal bFound As Boolean, _
ByRef lstBox As ListBox) _
As Long
'------------------------------------------------------------------------------
'
'
'------------------------------------------------------------------------------
Dim fso As New FileSystemObject
Dim fld As Folder
Dim tFld As Folder
Dim tFil As File
Dim FileName As String
'''''''''''''''''''''''''''''''''''''''
On Error GoTo ErrHandler

Set fld = fso.GetFolder(sFol)
FileName = Dir(fso.BuildPath(fld.Path, sFile), vbNormal Or _
 vbHidden Or vbSystem Or vbReadOnly)
 While Len(FileName) <> 0
   FindFile = FindFile + FileLen(fso.BuildPath(fld.Path, FileName)) 'calls itself
   iFiles = iFiles + 1
   lstBox.AddItem fso.BuildPath(fld.Path, FileName)  ' Load ListBox
   FileName = Dir()  ' Get next file
      DoEvents
   Wend
iDirs = iDirs + 1
If fld.SubFolders.Count > 0 And bFound = True Then
   For Each tFld In fld.SubFolders
      DoEvents
      FindFile = FindFile + FindFile(tFld.Path, sFile, iDirs, iFiles, True, lstBox)
   Next
End If
   
ErrHandler:
Select Case Err.Number
Case 0
   Err.Clear
Case Else
   Debug.Print Err.Number & " " & Err.description
   Err.Clear
End Select

End Function

[russell84]

Thanks for that borgunit - ive got the dialog working but just need to work on passing the path to the list box.

 

Thans for your help its a great start - cheers