Searching through a directory using a partial filename

Hello!

I am in need of help. I am trying to automate a very manual task in which I scour a bunch of excel files to copy and paste some info. So, our work orders (WO) are all created off a premade template. so the information I need is always in the same place on every file. I need a formula/program that can search a directory for a PARTIAL filename, and get info from a particular cell.

I say partial because the information I enter will be the beginning of the filename. For example: all our file names follow this format: (WO) (company) (State) (City).xls.

I want to type in SAL1234 (the WO) into Column A and have returned the value in $J$2 of the file 'SAL1234 RandomCorp TX Dallas.xls' in Column B for example.

I've spent this morning with NBVC trying to figure out a Formula funtion, but I get roadblocked by not having the full, accurate filename. And now I'm here

Oh and in case you're interested or need clarification, the other Thread I created is here: http://www.excelforum.com/excel-gene...cel-files.htmlgetting VBA help of which I've never used before.

Hello madadd,

I created a directory and saved several copies, with different names, of the program you posted. The new names were input onto a sheet in column "A" of the test workbook with the macro. The macro ran perfectly in my tests returning the value in J6 to the cell in column "B". Obviously, you are doing something differently but what that is I am not sure.

That being said, can you provide a detailed outline of the steps you are taking when running the program?

About the UDF:
It has nothing to do with the names given to files.
It has got everything to do with the order in which the method dir encounters a file according to the criteria.

if you put in F1:

PHP Code: 

=snb("Path","Extension",Row()) 


and autofill that to F200 you will see what I mean.

Hello madadd,

Perhaps this has to do with using a mapped drive. I don't have a local network to test the code to be sure. I used your workbooks and created a folder with a subfolder that has the WO in it. When tested using the macro below, it works. The only difference between this macro and the one in the Test workbook is the message. This version will alert you if there are no subfolders in the directory.

You should check your network settings and permissions to be sure your are being blocked or denied access.

Sub Worksheet_Change(ByVal Target As Range)

  Dim Item As Variant
  Dim N As Long
  Dim oFolder As Object
  Dim oShell As Object
  Dim SubFolder As Variant
  Dim SubFolders() As Variant
  Dim Wkb As Workbook
  
    If Target.Cells.Count > 1 Or Target.Column <> 1 Then Exit Sub
    
    Set oShell = CreateObject("Shell.Application")
    Set oFolder = oShell.Namespace("C:\My Test Folder")
        
      For Each Item In oFolder.Items
        If Item.IsFolder Then
          ReDim Preserve SubFolders(N)
          SubFolders(N) = Item.Path
          N = N + 1
        End If
      Next Item
      
      If N = 0 Then
         MsgBox "There are no Subfolders in this Folder."
         Exit Sub
      End If
      
      For Each SubFolder In SubFolders
        Set SubFolder = oShell.Namespace(SubFolder)
          For Each Item In SubFolder.Items
            If Item Like Target & "*.xls" Then
              Application.ScreenUpdating = False
                Set Wkb = Workbooks.Open(Item.Path)
                  Target.Offset(0, 1).Value = Worksheets("Pick Ticket").Range("J6").Value
                Wkb.Close SaveChanges:=False
              Application.ScreenUpdating = True
            End If
          Next Item
      Next SubFolder
      
    Set oShell = Nothing
    Set oFolder = Nothing
    
End Sub

Thank you for responding. I tried your code in a new sheet, and it isn't working once again for me. As I said, I think there's a problem with the IF statement. However, after A LOT of trial and error, and using the Debug.print I have come up with a working solution...though I think it's a little messy.

Sub Worksheet_Change(ByVal Target As Range)

  Dim Item As Variant
  Dim N As Long
  Dim oFolder As Object
  Dim oShell As Object
  Dim SubFolder As Variant
  Dim SubFolders() As Variant
  Dim Wkb As Workbook
  Dim FileName As String
    
    If Target.Cells.Count > 1 Or Target.Column <> 1 Then Exit Sub
    
    Set oShell = CreateObject("Shell.Application")
    Set oFolder = oShell.Namespace("U:\Work Orders\Work Orders 2011\")
    
      For Each Item In oFolder.Items
        If Item.IsFolder Then
           ReDim Preserve SubFolders(N)
           SubFolders(N) = Item.Path
           N = N + 1
        End If
      Next Item
      
      For Each SubFolder In SubFolders
        Set SubFolder = oShell.Namespace(SubFolder)
          For Each Item In SubFolder.Items
          Debug.Print Item
            FileName = Left(Item, 7)
            If FileName = Target Then
              Application.ScreenUpdating = False
                Set Wkb = Workbooks.Open(Item.Path)
                  Target.Offset(0, 1).Value = Sheets(1).Range("$J$6").Value
                Wkb.Close SaveChanges:=False
              Application.ScreenUpdating = True
            End If
          Next Item
      Next SubFolder
      
    Set oShell = Nothing
    Set oFolder = Nothing
    
End Sub

I don't particularly like the use of left() but it was kind of a work around for the possibly faulted IF statement. And also, could you be so kind and tell me what this does:
Set SubFolder = oShell.Namespace(SubFolder)

It worries me a little only because when I do a 'Debug.print Item' right after:
For Each Item In SubFolder.Items
It will display maybe 3/4 of the files plus some that would be in other completely different folders. For example, it'll display SAL3332-SAL3399 which is all in the same folder but it doesn't display SAL3300-SAL3331 which is in the same folder. The weirdest part of which is that I can still retrieve my J6 cell from any of those non displayed WOs. So maybe there's not really anything wrong with it?

*I also had to use your old 'Target.Offset(0, 1).Value = Sheets(1).Range("$J$6").Value' The new one gave me errors when I opened up the IF loop.

**Oh and also, I lied about the Sheets(1).Range("$J$6"). For some reason it only works with Sheets(2) the Pick Ticket one and not on the first work order one...any ideas on that?

Hello madadd,

The Like operator is a standard VBA language component. If you are having to use the Left function because the Like operator is failing then your VBA platform is corrupted. For now, if Left works then use it.

As for the statement :

Set SubFolder = oShell.Namespace(SubFolder)

This assigns the Folder object named by SubFolder's value to the Variant variable SubFolder. The Folder object is needed so the macro can examine what is in it.

Hello madadd,

This macro will take the entry from any cell in column "A" and check if the first part of any workbook (.xls) file name in the specified directory matches the cell contents. If a file is found then the contents of $J$2 on the the first sheet are returned in column B. Change the file path before installing the macro. The path is marked in bold.

Worksheet Change Event Macro

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim FileName As String
  Dim FilePath As String
  Dim FileType As String
  Dim Rng As Range
  Dim RngEnd As Range
  Dim Wkb As Workbook
  
    If Target.Cells.Count > 1 Or Target.Column <> 1 Then Exit Sub
    
    FileType = ".xls"
    FilePath = "C:\Documents and Settings\Owner\My Documents"
    
     FilePath = IIf(Right(FilePath, 1) <> "\", FilePath & "\", FilePath)
     FileName = Dir(FilePath & Target.Value & "*" & FileType)
     
     Application.ScreenUpdating = False
     
       If FileName <> "" Then
          Set Wkb = Workbooks.Open(FilePath & FileName)
            Target.Offset(0, 1).Value = Sheets(1).Range("$J$2").Value
          Wkb.Close SaveChanges:=False
       End If
     
     Application.ScreenUpdating = True
     
End Sub

How to Save a Worksheet Event Macro

1. Copy the macro using CTRL+C keys.
2. Open your Workbook and Right Click on the Worksheet's Name Tab for the Worksheet the macro will run on.
3. Left Click on View Code in the pop up menu.
4. Paste the macro code using CTRL+V
5. Make any custom changes to the macro if needed at this time.
6. Save the macro in your Workbook using CTRL+S

Hello madadd,

If you can post the workbook, it would help. Sub-directories can be searched recursively or to a particular depth. How deep to you want to go in MyDocuments?

Hello madadd,

Since there are no macros in this workbook, I have a couple of questions.

1. Is the $J$2 cell you are referring to on the "Pick Ticket" worksheet?
2. When a new Work Order is saved, is it only the "Work Order" sheet?