* function (search all) in VBA Excel

Macro
1

Hello, I have recovered an Excel VBA macro but I don't know how to modify it properly.
It searches for the plan number (Plan) and then the designation (Designation) but because some PDF names do not match exactly for the designation in the plan database, the copy fails.
I would like to replace Designation with something that is the equivalent of the Windows " * " search.

Here's the current macro:

ThisWorkbook.Sheets(" Sheet3 "). Cells(b, 1). Interior.Color = RGB(204, 255, 204)
LinkSearch = "  "
CopyLink = "  "
Plan = ThisWorkbook.Sheets(" Sheet3 "). Cells(b, 1). Text
Designation = ThisWorkbook.Sheets(" Sheet3 "). Cells(b, 2). Text
LinkSearch = "C:\FIVE-SERVICES\LIBRARY STANDARDS\Copie_PDF_Standard" & Plan & " - " & Designation & " .pdf "
CopyLink = ThisWorkbook.Sheets(" Sheet3 "). Cells(1, 4). Text & Plan & " - " & Designation & " .pdf "
FileCopy SearchLinkCopyLink

2

Hello

Not sure I understand. The goal is to search in the folder or in Excel?

1 Like
3

The goal is to search in the following folder for the name found in the excel. Except that the 2 don't match. So I would like him to copy even if he can't find the correct name of the designation.

4

Hello
Use the " Code " tag to post the codes. It will be much more readable this way.
The code you show us creates a search link. It does not do the research.

You must have a function that performs the search. Show us how it's made. :wink:

5

Is there at least one term that corresponds otherwise I don't see how to do it?
Instr function for this case.

6 
Public DerLigne As Long
Public DerPlan As Long
Public a As Long
Public b As Long
Public c As Long
Public LienRecherche As String
Public LienCopie As String
Public Plan As String
Public Désignation As String
Public TempsMacro As Double

Public Sub IdentifierPlans()

Application.ScreenUpdating = False
TempsMacro = Timer
DerPlan = ThisWorkbook.Sheets("Feuil3").Range("a65000").End(xlUp).Row

'With ThisWorkbook.Sheets("feuil3").Range("A1:B" & DerPlan)
With ThisWorkbook.Sheets("feuil3").Range(Cells(1, 1), Cells(DerPlan, 2))
    .ClearContents
    .Interior.TintAndShade = 0
    .Interior.Pattern = xlNone
    .Font.Color = RGB(0, 0, 0)
End With
 
DerLigne = ThisWorkbook.Sheets("feuil1").Range("c65000").End(xlUp).Row
b = 1
For a = 17 To DerLigne
    If ThisWorkbook.Sheets("feuil1").Cells(a, 1) = "x" Or ThisWorkbook.Sheets("feuil1").Cells(a, 1) = "X" Then
        If Left(ThisWorkbook.Sheets("feuil1").Cells(a, 3), 1) = "A" Then
        Else
            ThisWorkbook.Sheets("feuil3").Cells(b, 1) = LTrim(ThisWorkbook.Sheets("feuil1").Cells(a, 3))
            ThisWorkbook.Sheets("feuil3").Cells(b, 2) = LTrim(ThisWorkbook.Sheets("feuil1").Cells(a, 5))
            b = b + 1
        End If
    End If
Next a

ThisWorkbook.Sheets("feuil3").Range(Columns(1), Columns(2)).RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo

Application.ScreenUpdating = True

ThisWorkbook.Sheets("Feuil3").Cells(2, 4).Value = "Temps d'exe de la macro : " & Round(Timer - TempsMacro, 2) & " s"

End Sub

Public Sub CopierPlans()
TempsMacro = Timer
DerPlan = ThisWorkbook.Sheets("Feuil3").Range("a65000").End(xlUp).Row
c = 0
On Error GoTo Erreur
'On Error Resume Next


For b = 1 To DerPlan
Suite:
        ThisWorkbook.Sheets("Feuil3").Cells(b, 1).Interior.Color = RGB(204, 255, 204)
        LienRecherche = ""
        LienCopie = ""
        Plan = ThisWorkbook.Sheets("feuil3").Cells(b, 1).Text
        Désignation = ThisWorkbook.Sheets("feuil3").Cells(b, 2).Text
        LienRecherche = "C:\FIVE-SERVICES\BIBLIOTHEQUE STANDARDS\Copie_PDF_Standard\" & Plan & " - " & Désignation & ".pdf"
        LienCopie = ThisWorkbook.Sheets("feuil3").Cells(1, 4).Text & "\" & Plan & " - " & Désignation & ".pdf"
        FileCopy LienRecherche, LienCopie
Next b

ThisWorkbook.Sheets("Feuil3").Cells(2, 4).Value = "Temps d'exe de la macro : " & Round(Timer - TempsMacro, 2) & " s"

If c = 0 Then
    MsgBox "Nickel, tous les PDF ont été copiés", vbOKOnly, "Fichiers copiés"
Else
    If c = 1 Then
        MsgBox "Certains PDF ont été copiés mais il y a " & c & " erreur", vbExclamation + vbOKOnly, "Fichiers copiés partiellement"
    Else
        MsgBox "Certains PDF ont été copiés mais il y a " & c & " erreurs", vbExclamation + vbOKOnly, "Fichiers copiés partiellement"
    End If
End If
Exit Sub
Erreur:
ThisWorkbook.Sheets("Feuil3").Cells(b, 1).Interior.Color = RGB(255, 80, 80)
c = c + 1
Resume Next

End Sub

Here's the whole macro.

7

Your code references a FileCopy function: FileCopy LienRecherche, LienCopie

It may be in another module.

8

Yes, the beginning of the file is correct. Example: SDA-CAD-002-A - Stainless steel soldering souder.pdf when the search is made with " SDA-CAD-002-A - Stainless steel welding boss" so it can't find it. The beginning " SDA-CAD-002-A " is good. But I would like it to avoid " Stainless Steel Weld Boss" but still copy the file it finds with " SDA-CAD-002-A ".
Like when you " search " in Windows with " SDA-CAD-002-A*.pdf " in fact.

9

Uh, FileCopy is a function in itself, isn't it? It copies the files according to " LinkSearch " to "LinkCopy according to the 2 lines above?

10

Indeed, I don't know the VBA functions well.
So, there is no search function. Your code creates a path with the elements of the array.
So you have to create this search and replace the path with the resurltats of your search.
To help you, check out the GetFiles feature.