---

Hallo Leute,

ich arbeite gerade daran mich in die Makrowelt von V5 einzulesen und ein Makro zu erstellen, welches eine Produktstruktur erstellt und diese mit Parts befüllt.
Der Benutzer soll hierfür einen Pfad auswählen, in dem alle Unterordner nach einem entsprechenden CATPart durchsucht werden.
Die Erstellung der Produktstruktur und die Pfadauswahl durch den Benutzer funktionieren schon.
Die Bauteilsuche funktioniert auch aber nur, wenn sich das CATPart in dem Ordner befindet, welcher vom Benutzer angewählt wurde.
Sobald das Part in den Unterstrukturen gesucht werden soll, komme ich auf keine Lösung.
An "\*CATPart" muss ich offensichtlich etwas ändern, habe auch schon einiges versucht, allerdings ohne Erfolg.
Später möchte ich gerne nach der Teilenummer des Parts suchen, vorerst habe ich einfach nach einem beliebigen CATPart gesucht…
Der entsprechende Quelltext habe ich unten angefügt.

Kann mir hier Jemand weiterhelfen?

Vielen Dank schonmal

Grüße ARA
 
(BauteilOrdner) -> vom Benutzer gewählter Pfad

'Bauteil auf HDD suchen...
Dim BTpfad As String
Dim Bauteile As Object
       
Set Bauteile = CreateObject("Scripting.Dictionary")
BTpfad = Dir(BauteilOrdner & "\*CATPart")
       
MsgBox (BTpfad)

[Diese Nachricht wurde von ARA1702 am 02. Nov. 2015 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi ara,

eine kleine VBA Routine; nicht perfekt, aber es tut:

Code:

---

Option Explicit
Dim arrDirs() As String

Sub catmain()
   Dim strRootDir As String
   Dim strDummy As String
   Dim strFileToFind As String
   Dim n As Integer

   strRootDir = "E:\"
   strFileToFind = ".catpart"
   ReDim arrDirs(1)                                        'one more (stays empty)
   arrDirs(0) = strRootDir

   Do Until arrDirs(n) = ""                                'if array element is empty quit
      strDummy = arrDirs(n)
      ScanDir strDummy, strFileToFind
      n = n + 1
      DoEvents

   Loop
  
   Debug.Print "Dirs searched: " & n - 1

End Sub

Sub ScanDir(strPath As String, strFName As String)
   Dim strRet As String

   On Error GoTo ScanDir_Error

   strRet = Dir(strPath & "*.*", vbArchive Or vbDirectory)

   Do While strRet <> ""

      If strRet <> "." And strRet <> ".." Then
         ' Use bitwise comparison to make sure MyName is a directory.
         If (GetAttr(strPath & strRet) And vbDirectory) = vbDirectory Then
            arrDirs(UBound(arrDirs)) = strPath & strRet & "\"
            ReDim Preserve arrDirs(UBound(arrDirs) + 1)
         ElseIf UCase(Right(strRet, Len(strFName))) = UCase(strFName) Then
            Debug.Print strRet
         End If
      End If
GetNext:
      strRet = Dir
      DoEvents
   Loop

   Exit Sub
   '---------------------------------------------------------------------------------------
ScanDir_Error:
   Dim errMsg As String
   Dim errRet As VbMsgBoxResult

   Select Case Err.Number
      Case 52                                              'bad file name or number
         Resume GetNext

         '       Case -2147467259
      Case Else
         errMsg = Err.Number & ": " & Err.Description & " in procedure ScanDir"
         errRet = MsgBox(errMsg, vbOKOnly, "ScanDir")
   End Select

   'Resume Next                                          'fall thru to quit sub
   '---------------------------------------------------------------------------------------
End Sub

---

Die Routine gibt alle 'catparts' im Immediate-Fenster aus.
In Deinem Fall müsstest dem Such-String 'strFileToFind' den Catpart-Namen zuweisen.
Also anstelle von

Code:

---

ElseIf UCase(Right(strRet, Len(strFName))) = UCase(strFName) then

---

müsstest dann

Code:

---

ElseIf UCase(strRet) = UCase(strFName) then

---

schreiben.

Hope it helps,
Joe

------------------
Inoffizielle Catia Hilfeseite

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi Joehz,

vielen Dank für Deine VBA Routine, hierduch bin ich ein ganzes Stück weiter gekommen

Ich habe die Routine für meine Zwecke etwas angepasst und sie funktioniert gut, wenn ich nach einem kompletten Partnamen suche (z.B. 111_111_Test.CATPart). Die Suche mit einem Teil des Partnamens, wie "111_111_*" oder "*TEST.CATPart" geht leider nicht.

Gibt es hierbei noch ein grundlegendes Problem?
Hast Du nochmal einen Tipp für mich?

Besten Dank und viele Grüße
ARA

anbei der Quelltext:

Option Explicit
Dim arrDirs() As String
Dim Partfound As Boolean
Dim BTpfad As String

Sub catmain()
    Dim strRootDir As String
    Dim strDummy As String
    Dim strFileToFind As String
    Dim n As Integer
    Partfound = False
    BTpfad = "Error"

    strRootDir = "H:\"
    strRootDir = InputBox("Bitte geben Sie das Laufwerk der CAD Daten ein. ", "Name Laufwerk CAD Daten", strRootDir)
   
    strFileToFind = "BTN_111_111_XX_PCA_YY__001_____TESTPART___________KOMENTAR____________.CATPart"
    'strFileToFind = "BTN_111_111*"    'Abkürzungen zB Suche nach Bauteilnummer funktioniert nicht
   
    ReDim arrDirs(1)                                        'one more (stays empty)
    arrDirs(0) = strRootDir

    Do Until arrDirs(n) = "" Or Partfound = True            'if array element is empty quit
      strDummy = arrDirs(n)
      ScanDir strDummy, strFileToFind
      n = n + 1
      DoEvents

  Loop
 
  Debug.Print "Dirs searched: " & n - 1
  MsgBox (BTpfad)
   
End Sub

Sub ScanDir(strPath As String, strFName As String)
  Dim strRet As String
 
  On Error Resume Next
     
  strRet = Dir(strPath & "*.*", vbArchive Or vbDirectory)

  Do While strRet <> ""

      If strRet <> "." And strRet <> ".." Then
        ' Use bitwise comparison to make sure MyName is a directory.
        If (GetAttr(strPath & strRet) And vbDirectory) = vbDirectory Then
            arrDirs(UBound(arrDirs)) = strPath & strRet & "\"
            ReDim Preserve arrDirs(UBound(arrDirs) + 1)
            ElseIf UCase(strRet) = UCase(strFName) Then
            Debug.Print (strPath & strRet)
            Partfound = True
            BTpfad = (strPath & strRet)
            Exit Sub
        End If
      End If
GetNext:
      strRet = Dir
      DoEvents
  Loop

  Exit Sub

End Sub

Danke und viele Grüße
ARA

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi ara,
die Zeile musst auch anpassen, wenn Du einen Anfangs-Teilstring suchst.

Statt

ElseIf UCase(Right(strRet, Len(strFName))) = UCase(strFName) Then

für strFileToFind ="1234567"  'ohne asterisk!

müsste

ElseIf UCase(Left(strRet, Len(strFName))) = UCase(strFName) Then

stehen, weil Du jetzt die ersten n zeichen vergleichst.
Ohne Asterisk(*), weil der im Dateinamen nicht vorkommt.

Bei '"Test.CatPart' würd's wieder

ElseIf UCase(Left(strRet, Len(strFName))) = UCase(strFName) Then

heissen.
Lass' den Asterisk weg!

Tschau,
Joe

PS: Noch ein kleiner Nachtrag:
Unter Umständen kannst Du den Vergleich auch mit 'Instr' machen, zB.

...
ElseIf Instr(UCase(strRet), UCase(strFName)) Then
...

Für strFName = "123" findet die Anweisung alle Dateinamen mit der Sequenz '123' irgendwo im Dateinamen.

Lektüreempfehlungen: Left, Right, Instr, InstrRev; Mid + Mid$

Joe

------------------
Inoffizielle Catia Hilfeseite

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi Jo,

vielen Dank nochmal. 
Jetzt ist es klar geworden.

Grüße
ARA

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Servus,

ich muss das Thema nochmal aufwärmen...

Die Routine läuft für die Laufwerksuche sehr gut. Nun möchte ich jedoch kein ganzes Laufwerk durchsuchen, sondern nur einen Ordner mit all seinen Unterstrukturen. Das hat leider noch nicht geklappt.

Kann mir Jemand helfen?

Anbei der Quelltext aus meiner Testroutine:

Option Explicit
Dim arrDirs() As String
Dim Partfound As Boolean
Dim BTPfad As String
Private strRootDir As String
Private strFileToFind As String

Sub catMain()

Namenseingabe
Bauteilintegration

End Sub

Sub Namenseingabe()

    strRootDir = "H:\Unterverz\Beispiel"  'funktioniert nicht
    strRootDir = "H:\"                    'funktioniert
    strRootDir = InputBox("Bitte geben Sie das Laufwerk der CAD Daten ein. ", "Name Laufwerk CAD Daten", strRootDir)
   
End Sub

Sub Bauteilintegration()

Debug.Print "Suche startet"
strFileToFind = "BTN_111_111_XX_PCA_YY__001"
Suche
Debug.Print "Suche beendet"

End Sub

Sub Suche()

    'Dim strRootDir As String
    Dim strDummy As String
    'Dim strFileToFind As String
    Dim n As Integer
    Partfound = False
    BTPfad = "Error"
   

    'strFileToFind = "BTN_111_111_XX_PCA_YY__001"
   
    ReDim arrDirs(1)                                        'one more (stays empty)
    arrDirs(0) = strRootDir

    Do Until arrDirs(n) = "" Or Partfound = True            'if array element is empty quit
      strDummy = arrDirs(n)
      ScanDir strDummy, strFileToFind
      n = n + 1
      DoEvents

  Loop
 
  Debug.Print "Dirs searched: " & n - 1
  MsgBox (BTPfad)
   
End Sub

Sub ScanDir(strPath As String, strFName As String)
  Dim strRet As String
 
  On Error Resume Next
 
  'On Error GoTo ScanDir_Error    'Originaltext
 
  strRet = Dir(strPath & "*.*", vbArchive Or vbDirectory)

  Do While strRet <> ""

      If strRet <> "." And strRet <> ".." Then
        ' Use bitwise comparison to make sure MyName is a directory.
        If (GetAttr(strPath & strRet) And vbDirectory) = vbDirectory Then
            arrDirs(UBound(arrDirs)) = strPath & strRet & "\"
            ReDim Preserve arrDirs(UBound(arrDirs) + 1)
            ElseIf UCase(Left(strRet, Len(strFName))) = UCase(strFName) Then          'ElseIf UCase(strRet) = UCase(strFName) Then
            Debug.Print (strPath & strRet)
            Partfound = True
            BTPfad = (strPath & strRet)
            Exit Sub
        End If
      End If
GetNext:
      strRet = Dir
      DoEvents
  Loop

  Exit Sub

End Sub

Vielen Dank schon mal.

ARA

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi ara,

ungetestet:

Statt:

Code:

---

  strRootDir = "H:\Unterverz\Beispiel"  'funktioniert nicht
  strRootDir = "H:\"                    'funktioniert

---

schreib bitte

Code:

---

  strRootDir = "H:\Unterverz\Beispiel\"  'funktioniert nicht
  strRootDir = "H:\"                    'funktioniert

---

Tschau,
Joe

------------------
Inoffizielle Catia Hilfeseite

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Danke Jo

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP