* functie (alles doorzoeken) in VBA Excel

Macro
1

Hallo, ik heb een Excel VBA-macro hersteld, maar ik weet niet hoe ik deze correct moet wijzigen.
Er wordt gezocht naar het plannummer (Plan) en vervolgens naar de aanduiding (Designation), maar omdat sommige PDF-namen niet exact overeenkomen met de aanduiding in de plandatabase, mislukt de kopie.
Ik zou graag Aanduiding willen vervangen door iets dat het equivalent is van de Windows " * " zoekopdracht.

Dit is de huidige macro:

DitWerkboek.Bladen(" Blad3 "). Cellen (b, 1). Interieur.Kleur = RGB(204, 255, 204)
LinkSearch = "  "
CopyLink = "  "
Plan = DitWerkboek.Bladen(" Blad3 "). Cellen (b, 1). Sms
Aanduiding = DitWerkboek.Bladen(" Blad3 "). Cellen (b, 2). Sms
LinkSearch = "C:\FIVE-SERVICES\LIBRARY STANDARDS\Copie_PDF_Standard" & Plan & " - " & Aanduiding & " .pdf "
CopyLink = DitWerkboek.Bladen(" Blad3 "). Cellen(1, 4). Tekst & Plan & " - " & Aanduiding & " .pdf "
FileCopy SearchLinkCopyLink

2

Hallo

Ik weet niet zeker of ik het begrijp. Het doel is om in de map of in Excel te zoeken?

1 like
3

Het doel is om in de volgende map te zoeken naar de naam die in de excel is gevonden. Behalve dat de 2 niet overeenkomen. Dus ik zou graag willen dat hij kopieert, zelfs als hij de juiste naam van de aanduiding niet kan vinden.

4

Hallo
Gebruik de tag " Code " om de codes te posten. Het zal op deze manier veel leesbaarder zijn.
De code die u ons laat zien, maakt een zoeklink aan. Het doet het onderzoek niet.

U moet een functie hebben die de zoekopdracht uitvoert. Laat ons zien hoe het gemaakt is. :wink:

5

Is er ten minste één term die overeenkomt, anders zie ik niet hoe ik het moet doen?
Instr-functie voor dit geval.

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

Hier is de hele macro.

7

Uw code verwijst naar een FileCopy-functie: FileCopy LienRecherche, LienCopie

Het kan in een andere module zitten.

8

Ja, het begin van het bestand is correct. Voorbeeld: SDA-CAD-002-A - Roestvrij staal solderen souder.pdf wanneer de zoekopdracht is gemaakt met " SDA-CAD-002-A - Roestvrij staal lasnak" zodat het niet kan vinden. Het begin " SDA-CAD-002-A " is goed. Maar ik zou graag willen dat het " Stainless Steel Weld Boss" vermijdt, maar toch het bestand kopieert dat het vindt met " SDA-CAD-002-A ".
Zoals wanneer je in Windows " zoekt " met " SDA-CAD-002-A*.pdf " in feite.

9

Uh, FileCopy is een functie op zich, nietwaar? Het kopieert de bestanden volgens " LinkSearch " naar "LinkCopy volgens de 2 bovenstaande regels?

10

Inderdaad, ik ken de VBA niet goed werkt.
Er is dus geen zoekfunctie. Uw code maakt een pad met de elementen van de array.
U moet dus deze zoekopdracht maken en het pad vervangen door de antwoorden van uw zoekopdracht.
Bekijk de GetFiles-functie om u te helpen.