다른 키워드가있는 파일 검색

Question

파일을 찾아 전자 메일에 첨부하는 매크로를 작성하고 있습니다. 지정된 디렉토리 에서 시작 - - 다음과 같이

는 지금까지 내가 가지고 함께 코드를 해킹, 설계 일시적으로 생성 된 워크 시트 에 세포에 수출 디렉토리에 폴더>의 목록을 생성 - 폴더의 목록을 통해 루프,- 번호가 매겨진 작업 폴더를 찾으면 하위 폴더 "도면"이 하나 더 있는지 확인합니다. - 폴더에 레이블이 붙어있는 경우 "도면 (도면에있는 모든 하위 폴더)이 검색됩니다. "존재하면, 우리가 원하는 파일이 거기에있을 것입니다. - 폴더에 "그림"이라는 단어가없는 경우 원하는 파일이 번호가 매겨진 작업 폴더에 있습니다.

이제 메신저가 막혔습니다. 현재 내 코드는 "FIRST .pdf"라는 검색어로이 두 위치에서 파일을 찾습니다.

또한, 다른 문구와 함께 " .PDF", "University of Florida의 .PDF"을 "UPPER .PDF"를 예를 검색하고 싶습니다.

이 작업을 수행하는 가장 좋은 방법은 테이블의 셀을 참조하는 루프가되어야하므로 다른 임시 시트가 만들어지고 더 많은 셀이 채워지는 것이 좋습니까? 또는 루프 코드를 사용하지 않고도이 작업을 수행 할 수있는 까다로운 방법이 있습니까?

다시 말하지만, 제 코드는 내가 대략 배우는 것처럼 일종의 거칠게 해킹됩니다. 또한 매크로의 요구 사항은 사람들이 다른 사람이 할 수있는 것을 깨닫기 위해 계속 변하고 있기 때문에 논리는 한 번에 모두 설계되지 않았습니다. : \

Sub Concrete_Order() 
'code deleted from above area in question 


Dim foldersearchpath As String, ctr As Integer, UFPLANNAME As String, UFPLANpdf As String 

ctr = 1 

Sheets.Add After:=Sheets(Sheets.Count) 
ActiveSheet.Name = "asdf" 

Path = "K:\drafting\jobs\1DETAILING\" 'always have "\" at end 

FirstDir = Dir(Path, vbDirectory) 

    Do Until FirstDir = "" 
     If (GetAttr(Path & FirstDir) And vbDirectory) = vbDirectory Then 
      ActiveSheet.Cells(ctr, 1).Value = Path & FirstDir 
      ctr = ctr + 1 
     End If 

     FirstDir = Dir() 
    Loop 

Sheets("asdf").Select 

ctr = ctr - 1 'counter correction 

    Do Until ctr = 2 
     foldersearchpath = Range("A" & ctr) & "\" & jobNumber & "\" 

      Dim FldrCheck As String, FldrCheck2 As String, UFPlanFile As String 

      FldrCheck = Dir(foldersearchpath, vbDirectory) 

       If Len(FldrCheck) > 0 Then 

         FldrCheck2 = Dir(foldersearchpath & "drawings\", vbDirectory) 

          If Len(FldrCheck2) > 0 Then 

            foldersearchpath = foldersearchpath & "drawings\" 
            file = Dir(foldersearchpath & "*FIRST*.pdf") 


              If file <> "" Then 
                UFPlanFile = foldersearchpath & file 
                GoTo planfileFound 
              Else 
                GoTo UFPLAN_MANUAL_attach 
              End If 


          Else 

            file = Dir(foldersearchpath & "*FIRST*.pdf") 

             If file <> "" Then 

              UFPlanFile = foldersearchpath & file 
              GoTo planfileFound 
             Else 

              GoTo UFPLAN_MANUAL_attach 
             End If 



          End If 


       Else 

       End If 

     ctr = ctr - 1 
    Loop 

On Error GoTo 0 

UFPLAN_MANUAL_attach: 

Dim fd As Office.FileDialog 

Set fd = Application.FileDialog(msoFileDialogFilePicker) 

With fd 

     .AllowMultiSelect = False 
     .Application.FileDialog(msoFileDialogOpen).InitialFileName = foldersearchpath 
     .Title = "Could not find Upper Floor Plan, please locate..." 
     .Filters.Clear 
     .Filters.Add "Adobe PDF", "*.pdf" 
     .Filters.Add "John File", "*.god" 
     .Filters.Add "All Files", "*.*" 

     If .Show = True Then 'user clicked ok 
      UFPlanFile = .SelectedItems(1) 'replace txtFileName with your textbox 
     End If 

End With 


planfileFound: 

Application.DisplayAlerts = False 
Sheets("asdf").Select 
ActiveWindow.SelectedSheets.Delete 
Application.DisplayAlerts = True 


On Error GoTo 0 

'code deleted from after 
End Sub 

Answer 1

대부분의 프로그래밍 언어에는 동적 목록에 대한 inbuild 클래스가 있습니다. Vba에는 Collection 클래스가 있습니다. 당신은 .Add에 항목을 추가하고 (I)와 항목을 검색하거나

Sub Concrete_Order() 
    'code deleted from above area in question 


    Dim foldersearchpath As String, ctr As Integer, UFPLANNAME As String, UFPLANpdf As String 

    Dim foundDirectories As Collection 
    Set foundDirectories = New Collection 


    Path = "K:\drafting\jobs\1DETAILING\" 'always have "\" at end 

    FirstDir = Dir(Path, vbDirectory) 

    Do Until FirstDir = "" 
     If (GetAttr(Path & FirstDir) And vbDirectory) = vbDirectory Then 
      foundDirectories.Add Path & FirstDir 
     End If 

     FirstDir = Dir() 
    Loop 


    Dim possibleFileNames As Collection 
    Set possibleFileNames = New Collection 

    possibleFileNames.Add "*FIRST*.pdf" 
    possibleFileNames.Add "UPPER.pdf" 
    possibleFileNames.Add "1st.pdf" 
    possibleFileNames.Add "UF.pdf" 


    Dim currentDirectory 

    For Each currentDirectory In foundDirectories 

     foldersearchpath = currentDirectory & "\" & jobNumber & "\" 

     Dim FldrCheck As String, FldrCheck2 As String, UFPlanFile As String 

     FldrCheck = Dir(foldersearchpath, vbDirectory) 

     If Len(FldrCheck) > 0 Then 

      FldrCheck2 = Dir(foldersearchpath & "drawings\", vbDirectory) 

      If Len(FldrCheck2) > 0 Then 
       foldersearchpath = foldersearchpath & "drawings\" 
      End If 

      Dim possibleFileName 

      For Each possibleFileName In possibleFileNames 
       file = Dir(foldersearchpath & possibleFileName) 

       If file <> "" Then 

        UFPlanFile = foldersearchpath & file 

        GoTo planfileFound 

       End If 
      Next 

      GoTo UFPLAN_MANUAL_attach 

     End If 

    Next 

    On Error GoTo 0 

UFPLAN_MANUAL_attach: 

    Dim fd As Office.FileDialog 

    Set fd = Application.FileDialog(msoFileDialogFilePicker) 

    With fd 

      .AllowMultiSelect = False 
      .Application.FileDialog(msoFileDialogOpen).InitialFileName = foldersearchpath 
      .Title = "Could not find Upper Floor Plan, please locate..." 
      .Filters.Clear 
      .Filters.Add "Adobe PDF", "*.pdf" 
      .Filters.Add "John File", "*.god" 
      .Filters.Add "All Files", "*.*" 

      If .Show = True Then 'user clicked ok 
       UFPlanFile = .SelectedItems(1) 'replace txtFileName with your textbox 
      End If 

    End With 


planfileFound: 



    On Error GoTo 0 

'code deleted from after 
End Sub