使用FileSystemObject而不是Application.Filesearch搜索.xls文件

时间:2014-09-08 06:54:25

标签: excel-vba vba excel

我正在处理使用Office 2003完成的现有代码。在下面的代码中,DO直到搜索到ITP结束的值,如果有值,它将使用应用程序在目录中搜索它。 Filesearch。有没有办法使用FileSystemObject实现搜索功能?

Dim iTPSheetRef As String
Dim NextForm As String   
Dim QualityFormsPath As String
Dim NextFormLocation As String
Dim AmtDefaultSheets As Integer

Do Until Sheets("ITP Proforma").Cells(6,7) = "<<End of ITP>>"

        'Setting the ITPSheeetRef to the starting cell for the Checksheets
        iTPSheetRef = Sheets("ITP Proforma").Cells(6, 7)

        ' Checking to see whether the next row is blank
        ' If True Then + 1 to the row i.e. go to the following row
        ' If False Then Proceed with opening that particular form
        If Sheets("ITP Proforma").Cells(6, 7) = "" Then
            'True + 1 to the row i.e. go to the following row
            iTPSheetRef = Sheets("ITP Proforma").Cells(6, 8)
        Else
            'False Then Proceed with opening that particular form
            NextForm = iTPSheetRef & ".xls" ' Naming the Quality Sheet File with .xls extension

            'Determining the Path of the respective Quality Sheet
            '----------------------------------------------------

            'Checking out different folders for the default checksheets
            'First check to see whether the respective checksheet is in the Quality Forms Directory
            'i.e. the Default Directory for Quality Checksheets.
            'If not found in the above directory search for the checksheet in the Customs directory.
            'If not found in the Customs directory as well then produce a default checksheet

            'Find whether the respective checksheet is in the "Default" Quality Sheets directory
            With Application.FileSearch
                .NewSearch
                .FileName = NextForm
                .LookIn = QualityFormsPath
                .SearchSubFolders = True

                If .Execute() > 0 Then
                    'True - If the respective Checksheet is found in the "Default" Quality Sheets directory
                    'Then assign the variable NextFormLocation with the path for that particular form
                    For i = 1 To .FoundFiles.Count
                        PathInfo = .FoundFiles(i)
                        NextFormLocation = QualityFormsPath & NextForm
                    Next i
                Else
                    'False - If the respective Checksheet is not found in the "Default" Quality Sheets directory Then
                    'Searach for the checksheet in the customs directory as entered in the Instructions Form
                    .LookIn = CustomsFormsPath
                    .SearchSubFolders = True
                    If .Execute() > 0 Then
                        'True - If the checksheet was found in the Customs Path then
                        'Then assign the variable NextFormLocation with the path for that particular form
                        For j = 1 To .FoundFiles.Count
                            PathInfo = .FoundFiles(j)
                            NextFormLocation = CustomsFormsPath & NextForm
                        Next j
                    Else
                        'False - If the checksheet not found in either the "Default" directory or the Customs Directory
                        'Then produce a default blank checksheet
                        ChDir QualityFormsPath
                        NextForm = "a iXXX.xls"
                        NextFormLocation = QualityFormsPath & NextForm
                        AmtDefaultSheets = AmtDefaultSheets + 1
                    End If
                End If
            End With

1 个答案:

答案 0 :(得分:0)

是的,有

Sub findfilesindir()

Dim FSO As Scripting.FileSystemObject
Set FSO = CreateObject("Scripting.FileSystemObject")

Dim objFile As Scripting.File

For Each objFile In FSO.GetFolder("\\myfolder").Files
    Debug.Print objFile
Next

Set objFile = Nothing
Set FSO = Nothing
End Sub

让我自己的逻辑到我Debug.Print的位置。 File的默认返回值是带路径的文件名。