Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

VBA code to loop through directory getting only .dwg files

Posted on 2006-05-24
2
Medium Priority
?
27,555 Views
Last Modified: 2012-05-05
I need VBA code to loop through a directory and get only the .dwg files.  The code below will loop through the directory but it gets all file types.

Function GetAllFilesInDir(ByVal strDirPath As String) As Variant
    ' Loop through the directory specified in strDirPath and save each
    ' file name in an array, then return that array to the calling
    ' procedure.
    ' Return False if strDirPath is not a valid directory.
    Dim strTempName As String
    Dim varFiles() As Variant
    Dim lngFileCount As Long
   
    On Error GoTo GetAllFiles_Err
   
    ' Make sure that strDirPath ends with a "\" character.
    If Right$(strDirPath, 1) <> "\" Then
        strDirPath = strDirPath & "\"
    End If
   
    ' Make sure strDirPath is a directory.
    If GetAttr(strDirPath) = vbDirectory Then
        strTempName = Dir(strDirPath, vbDirectory)
        Do Until Len(strTempName) = 0
            ' Exclude ".", "..".
            If (strTempName <> ".") And (strTempName <> "..") Then
                ' Make sure we do not have a sub-directory name.
                If (GetAttr(strDirPath & strTempName) _
                    And vbDirectory) <> vbDirectory Then
                    ' Increase the size of the array
                    ' to accommodate the found filename
                    ' and add the filename to the array.
                    ReDim Preserve varFiles(lngFileCount)
                    varFiles(lngFileCount) = strTempName
                    lngFileCount = lngFileCount + 1
                End If
            End If
            ' Use the Dir function to find the next filename.
            strTempName = Dir()
        Loop
        ' Return the array of found files.
        GetAllFilesInDir = varFiles
    End If
GetAllFiles_End:
    Exit Function
GetAllFiles_Err:
    GetAllFilesInDir = False
    Resume GetAllFiles_End
End Function


Sub TestGetAllFiles()
    Dim varFileArray As Variant
    Dim lngI As Long
    Dim strDirName As String
   
   
    Const NO_FILES_IN_DIR As Long = 9
    Const INVALID_DIR As Long = 13
   
    On Error GoTo Test_Err
   
    strDirName = "E:\FSB\Plots"
    varFileArray = GetAllFilesInDir(strDirName)
    For lngI = 0 To UBound(varFileArray)
        Debug.Print varFileArray(lngI)
       
        Documents.Open strDirName & "\" & varFileArray(lngI)
            MsgBox "Name of this drawing is: " & ThisDrawing.Name
        ActiveDocument.Close , varFileArray(lngI)
       
    Next lngI
0
Comment
Question by:Cad Coder
2 Comments
 
LVL 13

Accepted Solution

by:
iHadi earned 2000 total points
ID: 16758316
Hi tlwaller

Replace your GetAllFilesInDir function with the following modified one:

Function GetAllFilesInDir(ByVal strDirPath As String) As Variant
    ' Loop through the directory specified in strDirPath and save each
    ' file name in an array, then return that array to the calling
    ' procedure.
    ' Return False if strDirPath is not a valid directory.
    Dim strTempName As String
    Dim varFiles() As Variant
    Dim lngFileCount As Long
   
    On Error GoTo GetAllFiles_Err
   
    ' Make sure that strDirPath ends with a "\" character.
    If Right$(strDirPath, 1) <> "\" Then
        strDirPath = strDirPath & "\"
    End If
   
    ' Make sure strDirPath is a directory.
    If GetAttr(strDirPath) = vbDirectory Then
        strTempName = Dir(strDirPath, vbDirectory)
        Do Until Len(strTempName) = 0
            ' Exclude ".", "..".
            If (strTempName <> ".") And (strTempName <> "..") Then
                ' Make sure we do not have a sub-directory name.
                If (GetAttr(strDirPath & strTempName) _
                    And vbDirectory) <> vbDirectory Then
                    ' Increase the size of the array
                    ' to accommodate the found filename
                    ' and add the filename to the array.
                If Right(strTempName,4) = ".dwg" then
                        ReDim Preserve varFiles(lngFileCount)
                        varFiles(lngFileCount) = strTempName
                        lngFileCount = lngFileCount + 1
                End If
                End If
            End If
            ' Use the Dir function to find the next filename.
            strTempName = Dir()
        Loop
        ' Return the array of found files.
        GetAllFilesInDir = varFiles
    End If
GetAllFiles_End:
    Exit Function
GetAllFiles_Err:
    GetAllFilesInDir = False
    Resume GetAllFiles_End
End Function
0
 
LVL 17

Expert Comment

by:zzzzzooc
ID: 16759191
Just adding to this PAQ.

I'm not sure if VBA supports this also, but VB's Dir() function supports the use of wildcards (ie: c:\*.txt). It'll make things much simpler.

Form1:
-----------------
Option Explicit
Private Sub Command1_Click()
    Dim files() As String
    If (FindFiles("c:\windows\system32\", "dll", files) = True) Then
        MsgBox "Files found: " & UBound(files) & vbCrLf & vbCrLf & _
               "1st file: " & files(0) & vbCrLf & _
               "2nd file: " & files(1)
    End If
End Sub
Private Function FindFiles(ByVal path As String, ByVal ext As String, ByRef files() As String) As Boolean
    Dim ffile As String
    ffile = Dir$(path & "*." & ext)
    Do
        If (ffile <> vbNullString) Then
            If (FindFiles = False) Then
                ReDim files(0) As String
                FindFiles = True
            Else
                ReDim Preserve files(UBound(files) + 1) As String
            End If
            files(UBound(files)) = ffile
            ffile = Dir
        Else
            Exit Do
        End If
    Loop Until (ffile = vbNullString)
End Function

0

Featured Post

Important Lessons on Recovering from Petya

In their most recent webinar, Skyport Systems explores ways to isolate and protect critical databases to keep the core of your company safe from harm.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
Suggested Courses
Course of the Month20 days, 22 hours left to enroll

810 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question