* Funktion (alle durchsuchen) in VBA Excel

Macro
1

Hallo, ich habe ein Excel-VBA-Makro wiederhergestellt, weiß aber nicht, wie ich es richtig ändern soll.
Es wird nach der Plannummer (Plan) und dann nach der Bezeichnung (Designation) gesucht, aber da einige PDF-Namen nicht genau mit der Bezeichnung in der Plandatenbank übereinstimmen, schlägt das Kopieren fehl.
Ich möchte die Bezeichnung durch etwas ersetzen, das der Windows-Suche " * " entspricht.

Hier ist das aktuelle Makro:

ThisWorkbook.Sheets(" Sheet3 "). Zellen (b, 1). Innenraum.Farbe = RGB(204, 255, 204)
LinkSuche = "  "
CopyLink = "  "
Plan = ThisWorkbook.Sheets(" Sheet3 "). Zellen (b, 1). Text
Bezeichnung = ThisWorkbook.Sheets(" Sheet3 "). Zellen (b, 2). Text
LinkSearch = "C:\FIVE-SERVICES\LIBRARY STANDARDS\Copie_PDF_Standard" & Plan & " - " & Bezeichnung & " .pdf "
CopyLink = ThisWorkbook.Sheets(" Blatt3 "). Zellen(1, 4). Text & Plan & " - " & Bezeichnung & " .pdf "
DateiKopieren SuchenLinkKopieren Link

2

Hallo

Ich bin mir nicht sicher, ob ich das verstehe. Das Ziel ist es, im Ordner oder in Excel zu suchen?

1 „Gefällt mir“
3

Ziel ist es, im folgenden Ordner nach dem in Excel gefundenen Namen zu suchen. Nur dass die 2 nicht zusammenpassen. Daher möchte ich, dass er kopiert, auch wenn er den korrekten Namen der Bezeichnung nicht finden kann.

4

Hallo
Verwenden Sie den " Code " -Tag, um die Codes zu posten. Auf diese Weise wird es viel besser lesbar sein.
Der Code, den Sie uns zeigen, erstellt einen Suchlink. Es recherchiert nicht.

Sie müssen über eine Funktion verfügen, die die Suche ausführt. Zeigen Sie uns, wie es hergestellt wird. :wink:

5

Gibt es mindestens einen Begriff, der dazu passt, sonst sehe ich nicht, wie ich es machen soll?
Instr-Funktion für diesen Fall.

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 ist das gesamte Makro.

7

Der Code verweist auf eine FileCopy-Funktion: FileCopy LienRecherche, LienCopie

Es kann sich in einem anderen Modul befinden.

8

Ja, der Anfang der Datei ist korrekt. Beispiel: SDA-CAD-002-A - Löten von Edelstahl souder.pdf, wenn die Suche mit " SDA-CAD-002-A - Schweißbuchse aus rostfreiem Stahl " durchgeführt wird, sodass es nicht gefunden werden kann. Der Anfang " SDA-CAD-002-A " ist gut. Aber ich möchte, dass es " Stainless Steel Weld Boss" vermeidet, aber trotzdem die Datei kopiert, die es mit " SDA-CAD-002-A " findet.
Wie wenn Sie in Windows mit " SDA-CAD-002-A*.pdf " suchen .

9

Äh, FileCopy ist eine Funktion für sich, nicht wahr? Es kopiert die Dateien gemäß " LinkSearch" nach "LinkCopy " gemäß den 2 Zeilen oben?

10

In der Tat weiß ich nicht, dass VBA gut funktioniert.
Es gibt also keine Suchfunktion. Der Code erstellt einen Pfad mit den Elementen des Arrays.
Sie müssen also diese Suche erstellen und den Pfad durch die Antworten Ihrer Suche ersetzen.
Um Ihnen zu helfen, sehen Sie sich die GetFiles-Funktion an.