VBA search string and substring

Question

I have to search and copy a number of files in a folder starting from an Excel list like:

8100
8152
8153

in the folder there are files named like this:

8100.pdf
100_8152.pdf
102_8153.pdf
8153 (2).pdf

How can I search these files without renaming all the files? Thanks to user3598756, this is the code I'm now using for searching files with the same name in excel list and in the file folder:

Option Explicit

Sub cerca()
Dim T As Variant
Dim D As Variant

T = VBA.Format(VBA.Time, "hh.mm.ss")
D = VBA.Format(VBA.Date, "yyyy.MM.dd")

Dim Source As String
Dim Dest As String
Dim Missed As String
Dim fileFound As String
Dim CodiceCS As Variant
Dim cell As Range

Source = "D:\myfolder\"
Dest = "D:\myfolder\research " & D & " " & T

If Dir(Dest, vbDirectory) = "" Then MkDir Dest '<--| create destination folder if not alerady there

With Worksheets("Cerca") '<-- reference your worksheet with pdf names
    For Each cell In .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeConstants) '<-- loop through its column "A" cells with "constant" (i.e. not resulting from formulas) values from row 2 down to last non empty one
        CodiceCS = VBA.Left((cell.Value), 4)
        fileFound = Dir(Source & "\" & CodiceCS & "\*" & cell.Value & "*.Pdf") '<-- look for a source folder file whose name contains the current cell value
        If fileFound <> "" Then '<-- if found...
            FileCopy Source & "\" & CodiceCS & "\" & fileFound, Dest & "\" & fileFound '<-- ...copy to destination folder
        Else '<--otherwise...
            Missed = Missed & cell.Value & vbCrLf '<--... update missing files list
        End If
    Next cell
End With

If Missed <> "" Then '<-- if there's any missing file
    Dim FF As Long
    FF = FreeFile

    Open (Dest & "\" & "MissingFiles.txt") For Output As #FF
    Write #FF, VBA.Left(Missed, Len(Missed) - 2)
    Close #FF
End If

MsgBox "OK"
Shell "explorer.exe " + Dest, vbNormalFocus

End Sub

The code works with all files with prefix but not with files with suffix (ie: "8153 (2).pdf"). The code returns only one file, but I need All the files matching the cell value. I need to extend my research in subfolders organized by years too (ie: "D:\myfolder\2015", "D:\myfolder\2016", etc.).

Look at the function InStr - it will give you all you need to answer this question. If you have trouble with it, come back and explain the issue and we can help you get it sorted... — Dave
– Dave, Commented Sep 30, 2016 at 13:31
Thanks Dave, but how can I use the returned InStr value for my research? — ufollettu
– ufollettu, Commented Oct 4, 2016 at 7:25

user3598756 · Accepted Answer · 2016-10-01 10:38:45Z

1

other than InStr() function, you could use Dir() with asterisks (*), like in following (commented) code:

Option Explicit

Sub search()
    Dim Source As String, Dest As String, Missed As String, fileFound As String
    Dim cell As Range

    Source = "D:\varie\Lavoro\Programming\VBA\Forum\Stack Overflow\Test\"
    Dest = "D:\varie\Lavoro\Programming\VBA\Forum\Stack Overflow\Test\output"
    'Source = "D:\myfolder\"
    'Dest = "D:\myfolder\research"
    If Dir(Dest, vbDirectory) = "" Then MkDir Dest '<--| cerate destination folder if not alerady there
    With Worksheets("PDF") '<-- reference your worksheet with pdf names (change "PDF" to your actual sheet name)
        For Each cell In .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeConstants) '<-- loop through its column "A" cells with "constant" (i.e. not resulting from formulas) values from row 2 down to last non empty one
            fileFound = Dir(Source & "\*" & cell.Value & "*.Pdf") '<-- look for a source folder file whose name contains the current cell value
            If fileFound <> "" Then '<-- if found...
                FileCopy Source & fileFound, Dest & "\" & fileFound '<-- ...copy to destination folder
            Else '<--otherwise...
                Missed = Missed & cell.Value & vbCrLf '<--... update missing files list
            End If
        Next cell
    End With

    If Missed <> "" Then '<-- if there's any missing file
        Dim FF As Long
        FF = FreeFile

        Open (Dest & "\" & "MissingFiles.txt") For Output As #FF
        Write #FF, Left(Missed, Len(Missed) - 2)
        Close #FF
    End If

    MsgBox "OK"
    Shell "explorer.exe " + Dest, vbNormalFocus
End Sub

as you can see I also slightly changed some other parts of your code to make it a little more robust

answered Oct 1, 2016 at 10:38

user3598756

29.5k4 gold badges20 silver badges30 bronze badges

Sign up to request clarification or add additional context in comments.

2 Comments

ufollettu Over a year ago

Thanks a lot, with some edits the code works, but I need to search in multiple sources (subfolders in "source") like source\2015, source\2016, etc. How can I do this?

ufollettu Over a year ago

Update: The macro finds only the files with a prefix, not the files without it like "8152 (2).pdf

Community · Accepted Answer · 2017-05-23 12:33:15Z

You should make like this other post : Excel VBA function that checks if filename CONTAINS the value

1) Loop though all the files in your directory
2) Test if the filename contains any of your strings with the function
ContainsAny(string source, string[] str_to_find, boolean caseSensitive)
proposed by "Mat's Mug" in the post linked above.
3) if the file contains any of the strings you are searching (function returning TRUE), copy that file

Public Function ContainsAny(ByVal string_source As String, ByVal caseSensitive As Boolean, ParamArray find_strings() As Variant) As Boolean

Dim find As String, i As Integer, found As Boolean

For i = LBound(find_strings) To UBound(find_strings)

    find = CStr(find_strings(i))
    found = Contains(string_source, find, caseSensitive)

    If found Then Exit For
Next

ContainsAny = found
End Function

Collectives™ on Stack Overflow

VBA search string and substring

2 Answers 2

2 Comments

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

2 Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related