Folder loop for dwg

[Anonymous]

hi,

I am trying to create a block extractor using VBA. As for the extractor code, I believe it's finished, but I need to apply it to different files. As such, I need to create a loop in a folder.

I looked around and found this great piece of code for looping .xlsx, but I can't make it work for .dwg files.

Sub AllWorkbooks()

   Dim MyFolder As String ‘Path collected from the folder picker dialog

   Dim MyFile As String ‘Filename obtained by DIR function

   Dim wbk As Workbook ‘Used to loop through each workbook

On Error Resume Next

Application.ScreenUpdating = False

‘Opens the folder picker dialog to allow user selection

With Application.FileDialog(msoFileDialogFolderPicker)

.Title = “Please select a folder”

.Show

.AllowMultiSelect = False

   If .SelectedItems.Count = 0 Then ‘If no folder is selected, abort

MsgBox “You did not select a folder”

      Exit Sub

   End If

MyFolder = .SelectedItems(1) & “\” ‘Assign selected folder to MyFolder

End With

myfile = Dir(MyFolder) ‘DIR gets the first file of the folder

‘Loop through all files in a folder until DIR cannot find anymore

Do While myfile <> “”

   ‘Opens the file and assigns to the wbk variable for future use

   Set wbk = Workbooks.Open(Filename:=MyFolder & myfile)

   ‘Replace the line below with the statements you would want your macro to perform

Sheets(2).Range(“a1”).Value = 60

wbk.Close savechanges:=True

MyFile = Dir ‘DIR gets the next file in the folder

Loop

Application.ScreenUpdating = True

End Sub

The code is very well explained by the creator, https://www.youtube.com/watch?v=J0PeXcAVaUM

Any help would be deeply appreciated 🙂 

[norman.yuan]

You did not explicitly say, but I assume your "block extractor" run in AutoCAD VBA. The code you found/showed here is for Excel VBA, so, you need to make some changes on two things:

1. In AutoCAD VBA, there is NO BUILT-IN function to call up a "Folder Picker" dialog box for user to select a folder. You need to use WINDOW API's Folder Browser to 64-bit, which had been discussed in this forum a few times before. 

2. The code of using Dir() to loop through a folder needs minor change. But, unlike the code you showed here, I strongly recommend you use Dir() to obtain a list of file names, instead of do anything to each file within each loop (such as in the code where in each loop, a sheet was updated and then closed; then going to another sheet file...). So the code would be like:

Function GetDwgFiles(folderPath As String) As Variant

  Din i As Integer

  Dim files() As String

  Dim fName As string

  fName=Dir(folderPath & "\*.dwg")

  Do While (fName<>"")

    ReDim Preserve files(i)

    files(i)=fName

    i = i + 1

    fName = Dir

  Loop

  GetDwgFiles = files

End Function

Then in block extractor code, you do

Dim folder As String

'' you need to find something to let user to pick the folder, as aforementioned

'' you can search the net for "folder browser 64-bit". Warning, it is not an easy

'' thing, if you are not experienced programmer

folder = "....." 

Dim files As Variant

files = GetDwgFiles(folder)

Dim i As Interger

Dim dwgFile

For i = 0 To Ubound(files)

    dwgFile = files(i)

    //Do the block extracting work with this drawing file

Next

[Anonymous]

Although the users have AutoCAD knowledge, I intend to launch the macro from excel, with a click of a button. 

Since your tips were for AutoCAD VBA, what do you recommend for Excel VBA?

thanks in advance

[norman.yuan]

If you actually run Excel VBA, the my code would be the same, except for 

Dim folder As String

folder =  "...."

Can be easily changed to 

folder=GetFolder()

If Len(folder)=0 Then

  Exit sub

End If

'' Now get file list in the folder

'' Then process each file in the file list/array

Function GetFolder() As string

  Dim MyFolder As String

  With Application.FileDialog (msoFileDialogFolderPicker)

    ... 

   '' Same code as in your original post

   ...

  MyFolder = .SelectedItems(1) 

  End With

  GetFolder = MyFolder

End Function

[Anonymous]

Thanks, will give it a try tomorrow 🙂