+ Reply to Thread
Results 1 to 5 of 5

search directory, list files containing certain txt

Hybrid View

  1. #1
    Forum Expert
    Join Date
    01-15-2007
    Location
    Brisbane, Australia
    MS-Off Ver
    2007
    Posts
    6,591
    Hi

    Try this. It assumes that you are in the directory that contains the files you want to check.


    Sub aaa()
      Dim OutSH As Worksheet
      Set OutSH = ThisWorkbook.Sheets("Sheet1")
      Application.ScreenUpdating = False
      filess = Dir("*.xls")
      If filess <> "" Then
        Do
          If filess <> ThisWorkbook.Name Then
            Workbooks.Open Filename:=filess, UpdateLinks:=False
            alinks = ActiveWorkbook.LinkSources(xlExcelLinks)
            If Not IsEmpty(alinks) Then
              For i = LBound(alinks) To UBound(alinks)
                outrow = OutSH.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
                OutSH.Cells(outrow, 1).Value = ActiveWorkbook.Name
                OutSH.Cells(outrow, 2).Value = alinks(i)
              Next i
            End If
            ActiveWorkbook.Close savechanges:=False
          End If
          filess = Dir()
        Loop Until filess = ""
      End If
      Application.ScreenUpdating = True
    End Sub
    rylo

  2. #2
    Registered User
    Join Date
    04-17-2008
    Location
    Yorkshire
    Posts
    79
    Quote Originally Posted by rylo
    Hi

    Try this. It assumes that you are in the directory that contains the files you want to check.


    Sub aaa()
      Dim OutSH As Worksheet
      Set OutSH = ThisWorkbook.Sheets("Sheet1")
      Application.ScreenUpdating = False
      filess = Dir("*.xls")
      If filess <> "" Then
        Do
          If filess <> ThisWorkbook.Name Then
            Workbooks.Open Filename:=filess, UpdateLinks:=False
            alinks = ActiveWorkbook.LinkSources(xlExcelLinks)
            If Not IsEmpty(alinks) Then
              For i = LBound(alinks) To UBound(alinks)
                outrow = OutSH.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
                OutSH.Cells(outrow, 1).Value = ActiveWorkbook.Name
                OutSH.Cells(outrow, 2).Value = alinks(i)
              Next i
            End If
            ActiveWorkbook.Close savechanges:=False
          End If
          filess = Dir()
        Loop Until filess = ""
      End If
      Application.ScreenUpdating = True
    End Sub
    rylo
    Thanks for your effort Rylo, but I have my confused head on again this morning, too much beer over the weekend. Where do I enter the 'link' I'm wanting the macro to search for? Or does it assume its checking the file for links to the workbook it's being run from? I tried to play around and try it either way, but I keep getting no results.

  3. #3
    Forum Expert
    Join Date
    01-15-2007
    Location
    Brisbane, Australia
    MS-Off Ver
    2007
    Posts
    6,591
    Hi

    What that code will do is open all the files in the directory, and if they have links to any other files, the filename and the link reference will be put into sheet1 of the workbook containing the macro.

    Once this has completed, you can search in the link references for any of the files you are chasing.

    rylo

  4. #4
    Registered User
    Join Date
    04-17-2008
    Location
    Yorkshire
    Posts
    79
    Quote Originally Posted by rylo
    Hi

    What that code will do is open all the files in the directory, and if they have links to any other files, the filename and the link reference will be put into sheet1 of the workbook containing the macro.

    Once this has completed, you can search in the link references for any of the files you are chasing.

    rylo
    First class, that should keep me going!! Many thanks.

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1