dneprcomp
Silver Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
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
|
Всего записей: 3920 | Зарегистр. 31-03-2002 | Отправлено: 17:23 12-11-2010 | Исправлено: dneprcomp, 17:35 12-11-2010 |
|
