What's Here?

Members: 107,669
Replies: 409,538
Topics: 62,198
Snippets: 2,253
Tutorials: 602
Total Online: 1,046
Members: 49
Guests: 997

Visual Basic

Welcome to Dream.In.Code
	Getting VB Help is Easy! Join 107,669 VB Programmers for FREE! Ask your question and get quick answers from experts. There are 1,046 online right now! We've got more than 500 tutorials and 2,000 snippets. Join and find out why Dream.In.Code is the #1 programming help community on the internet! Registration is fast and FREE... Join Now! Chat LIVE With a VB Expert Register to Make This Box Go Away!

Slight code tweak required

Slight code tweak required, Pasting into subsequent rows

Options

pboltonchina

31 Jul, 2008 - 10:47 PM

Post #1

New D.I.C Head

Joined: 31 Jul, 2008
Posts: 3

Hi,

I'm using the following code to search for a number in a folder and subfolders and paste the hyperlinked result onto a results page. The problem comes when there are more than 1 search results, I need them to paste down, i.e. 1st result in H2, 2nd in H3 and so on. Could anyone tweak the code for me please? I would also like the cells H2, H3 etc to show 'Drawing'. instead of the full file path and name if possible
Thanks for looking at my question


& #39;============================================================================
=
'- SEARCH ALL FILES IN A FOLDER & FIND STRING IN FILE NAME
'- PUT NAMES INTO ACTIVE SHEET AT BOTTOM OF COLUMN A
'- (search is not case sensitive)
'- Brian Baulsom July 2008
& #39;============================================================================
=
Sub FIND_DRAWING()
    Dim FindText As String
    Dim MyFolder As String
    Dim MyFileCount As Integer
    Dim MyFileName As String
    Dim MyFileType As String
    Dim f
    Dim WS As Worksheet
    '-------------------------------------------------------------------------
    '- SET VARIABLES
    Set WS = ActiveSheet
    MyFolder = "H:\SERVICE CENTRE DETAILS\INSPECTION DRAWINGS and DOCUMENTS"
    FindText = WS.Range("B2").Value
    MyFileType = "*" & FindText & "*.*"     ' = "*Test*.*"
    '-------------------------------------------------------------------------
    '- CHECK FILE NAMES
    With Application.FileSearch
        .NewSearch
        .LookIn = MyFolder
        .Filename = MyFileType
        .SearchSubFolders = True   ' True to search subfolders
        '---------------------------------------------------------------------
        '- RESULTS
        MyFileCount = 0
        If .Execute() > 0 Then
            MyFileCount = .FoundFiles.Count
            For f = 1 To MyFileCount
                MyFileName = .FoundFiles(f)
                WS.Range("H2").Value = WS.Range("H2").Value & " " & MyFileName
                WS.Hyperlinks.Add anchor:=WS.Range("H2"), Address:=MyFileName

           Next
        Else
            MsgBox ("Search for file names containing : " & FindText & vbCr _
                & "No matches found")
                Exit Sub
        End If
    End With
    '--------------------------------------------------------------------------
    '- finish
    MsgBox ("Found " & MyFileCount & " file names.")
End Sub

Mod Edit: Please use code tags when posting your code =>

Thanks

This Post Was Helpful! ^New!

Register for Free to Make This Ad Go Away!

pboltonchina	1 Aug, 2008 - 05:34 PM Post #2
New D.I.C Head Joined: 31 Jul, 2008 Posts: 3	Hi all, I'm using the following code to search for a drawing number in a folder and place the resultant hyperlink in cell H2 on an excel spreadsheet. The problem comes when there is more than one search result. How can the code be tweaked so that the first result is linked from H2, the second from H3 and so on until all the results are hyperlinked? CODE ============================================================================= '- SEARCH ALL FILES IN A FOLDER & FIND STRING IN FILE NAME '- PUT NAMES INTO ACTIVE SHEET AT BOTTOM OF COLUMN A '- (search is not case sensitive) '& #39;============================================================================ = Sub FIND_DRAWING() Dim FindText As String Dim MyFolder As String Dim MyFileCount As Integer Dim MyFileName As String Dim MyFileType As String Dim f Dim WS As Worksheet '------------------------------------------------------------------------- '- SET VARIABLES Set WS = ActiveSheet MyFolder = "H:\SERVICE CENTRE DETAILS\INSPECTION DRAWINGS and DOCUMENTS\Misc Drawings" FindText = WS.Range("B2").Value MyFileType = "" & FindText & "." ' = "Test." '------------------------------------------------------------------------- '- CHECK FILE NAMES With Application.FileSearch .NewSearch .LookIn = MyFolder .Filename = MyFileType .SearchSubFolders = False ' True to search subfolders '--------------------------------------------------------------------- '- RESULTS MyFileCount = 0 If .Execute() > 0 Then MyFileCount = .FoundFiles.Count For f = 1 To MyFileCount MyFileName = .FoundFiles(f) WS.Range("H2").Value = WS.Range("H2").Value & " " & MyFileName WS.Hyperlinks.Add anchor:=WS.Range("H2"), Address:=MyFileName, TextToDisplay:="Drawing" Next Else MsgBox ("Search for file names containing : " & FindText & vbCr _ & "No matches found") Exit Sub End If End With '-------------------------------------------------------------------------- '- finish MsgBox ("Found " & MyFileCount & " file names.") End Sub This is my first time here, thank you for looking at my post, any help would be greatly appreciated. Kind Regards Paul
	This Post Was Helpful! ^New!

jayman9	1 Aug, 2008 - 08:24 PM Post #3
Student of Life Joined: 26 Dec, 2005 Posts: 6,300 Thanked 21 times Dream Kudos: 500 Expert In: C#, VB.NET, Java My Contributions	Topics merged. Please do not create duplicate topics.
	This Post Was Helpful! ^New!

AdamSpeight2008	2 Aug, 2008 - 12:19 AM Post #4
D.I.C Regular Joined: 29 May, 2008 Posts: 493 Thanked 31 times Dream Kudos: 1900 My Contributions	Try this, my need tweaking it been a while since i've use vb6 CODE ============================================================================= '- SEARCH ALL FILES IN A FOLDER & FIND STRING IN FILE NAME '- PUT NAMES INTO ACTIVE SHEET AT BOTTOM OF COLUMN A '- (search is not case sensitive) '& #39;============================================================================ = Dim FoundRow as integer=1 Sub FIND_DRAWING() Dim FindText As String Dim MyFolder As String Dim MyFileCount As Integer Dim MyFileName As String Dim MyFileType As String Dim f Dim WS As Worksheet '------------------------------------------------------------------------- '- SET VARIABLES Set WS = ActiveSheet MyFolder = "H:\SERVICE CENTRE DETAILS\INSPECTION DRAWINGS and DOCUMENTS\Misc Drawings" FindText = WS.Range("B2").Value MyFileType = "" & FindText & "." ' = "Test." '------------------------------------------------------------------------- '- CHECK FILE NAMES With Application.FileSearch .NewSearch .LookIn = MyFolder .Filename = MyFileType .SearchSubFolders = False ' True to search subfolders '--------------------------------------------------------------------- '- RESULTS MyFileCount = 0 If .Execute() > 0 Then MyFileCount = .FoundFiles.Count For f = 1 To MyFileCount FoundRow =FoundRow +1 MyFileName = .FoundFiles(f) WS.Range("H" & Cstr(FoundRow )).Value = WS.Range("H" & Cstr(FoundRow )).Value & " " & MyFileName WS.Hyperlinks.Add anchor:=WS.Range("H"& Cstr(FoundRow )), Address:=MyFileName, TextToDisplay:="Drawing" Next Else MsgBox ("Search for file names containing : " & FindText & vbCr _ & "No matches found") Exit Sub End If End With '-------------------------------------------------------------------------- '- finish MsgBox ("Found " & MyFileCount & " file names.") End Sub
	This Post Was Helpful! ^New!