Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  SolidWorks Workgroup PDM
  PDM nach PDF/DXF mit Excelliste

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
Autor Thema:  PDM nach PDF/DXF mit Excelliste (140 mal gelesen)
Fränky77
Mitglied
Konstrukteur

Sehen Sie sich das Profil von Fränky77 an!   Senden Sie eine Private Message an Fränky77  Schreiben Sie einen Gästebucheintrag für Fränky77

Beiträge: 3
Registriert: 20.09.2022

erstellt am: 20. Sep. 2022 08:43    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities


StucklistemitExporttool_01.zip

 
Hallo ich bin ein absoluter Neuling...

Bin auf Suche nach einem Makro das folgende Voraussetzungen erfüllen soll:

Aus einer Exceldatei sollen die freigegebenen Fremdformate im PDM gesucht werden. Schön wäre auch noch bei Zeichnungen die als einzelne DXF Dateien abgeleitet werden. Die folge Seiten auch noch mit in Suche aufzunehmen
Wir haben schon ein Makro aber da kommen nicht alle Infos zurück.

Wäre super, wenn mir hier jemand helfen könnte…

Option Explicit

Public Sub CopyFiles()

'1.) Ordnerpfad definieren

  Dim strFolderPath As String
  strFolderPath = "C:\Export\"
  ' Überprüfen, ob Ordner bereits existiert
  If Dir(strFolderPath, vbDirectory) = "" Then
    ' Ordner anlegen
    MkDir (strFolderPath)
    MsgBox "Ordner wird angelegt!"
  Else
    MsgBox "Ordner ist vorhanden!"
  End If
 
'2.) Ordner befüllen

   Const INPUT_PATH As String = "C:\SWx_PDM\"  'Anpassen !!! Backslash am _
Ende nicht löschen
    Const OUTPUT_PATH As String = "C:\Export\" 'Anpassen !!! _Backslash am Ende nicht löschen
    Dim astrFolders() As String, strFilename As String
    Dim avntValues As Variant, vntItem As Variant
    Dim ialngFolders As Long, ialngIndex As Long, lngCount As Long
    Dim objDictionary As Object
    Set objDictionary = CreateObject(Class:="Scripting.Dictionary")
    Range(Cells(2, 2), Cells(Rows.Count, 2)).ClearContents
    avntValues = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp)).Value2
    With objDictionary
        For ialngIndex = LBound(avntValues) To UBound(avntValues)
            If Not .Exists(Key:=avntValues(ialngIndex, 1)) Then
                Call .Add(Key:=avntValues(ialngIndex, 1), Item:=ialngIndex + 1)
            Else
                Cells(ialngIndex + 1, 2).Value = ""
            End If
        Next
        astrFolders = GetFolders(INPUT_PATH)
        For Each vntItem In .Keys
            lngCount = 0                                                                             'Schleife für .PDF Export'
            For ialngFolders = LBound(astrFolders) To UBound(astrFolders)
                strFilename = Dir$(astrFolders(ialngFolders) & vntItem & "*.pdf")
                If strFilename <> vbNullString Then
                    Call FileCopy(Source:=astrFolders(ialngFolders) & strFilename, Destination:= _
OUTPUT_PATH & strFilename)
                    lngCount = 1                                                                     'Schleife für .step Export'
                End If
                strFilename = Dir$(astrFolders(ialngFolders) & vntItem & "*.step")
                If strFilename <> vbNullString Then
                    Call FileCopy(Source:=astrFolders(ialngFolders) & strFilename, Destination:= _
OUTPUT_PATH & strFilename)
                    lngCount = 2
                End If
                strFilename = Dir$(astrFolders(ialngFolders) & vntItem & "*.dxf")                    'Schleife für .dxf Export'
                If strFilename <> vbNullString Then
                    Call FileCopy(Source:=astrFolders(ialngFolders) & strFilename, Destination:= _
OUTPUT_PATH & strFilename)
                    lngCount = lngCount + 1
                End If
                If lngCount = 3 Then Exit For
            Next
            If lngCount = 0 Then
                Cells(.Item(Key:=vntItem), 2).Value = "Nicht vorhanden"
            Else
                Cells(.Item(Key:=vntItem), 2).Value = "Vorhanden"
            End If
        Next
    End With
    Set objDictionary = Nothing
End Sub

Private Function GetFolders(ByVal pvstrPath As String) As String()
    Dim astrFolders() As String
    Dim strFolder As String, strPath As String
    Dim ialngIndex1 As Long, ialngIndex2 As Long
    ReDim Preserve astrFolders(ialngIndex1)
    astrFolders(ialngIndex1) = pvstrPath
    ialngIndex1 = 1
    ialngIndex2 = 1
    strPath = pvstrPath
    Do
        strFolder = Dir$(PathName:=strPath & "*", Attributes:=vbDirectory)
        Do Until strFolder = vbNullString
            If strFolder <> "." And strFolder <> ".." Then
                If GetAttr(PathName:=strPath & strFolder) And vbDirectory Then
                    ReDim Preserve astrFolders(0 To ialngIndex1)
                    astrFolders(ialngIndex1) = strPath & strFolder & "\"
                    ialngIndex1 = ialngIndex1 + 1
                End If
            End If
            strFolder = Dir$
        Loop
        If ialngIndex1 = ialngIndex2 Then Exit Do
        strPath = astrFolders(ialngIndex2)
        ialngIndex2 = ialngIndex2 + 1
    Loop
    GetFolders = astrFolders
End Function


Viele Grüße Fränky
Ach so: Den Orginalcode habe ich  hierher:
https://www.herber.de/forum/archiv/1784to1788/1786970_Dateien_anhand_Liste_suchen_und_kopieren.html

[Diese Nachricht wurde von Fränky77 am 20. Sep. 2022 editiert.]

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

riesi
Mitglied
Konstrukteur, CAD-Admin


Sehen Sie sich das Profil von riesi an!   Senden Sie eine Private Message an riesi  Schreiben Sie einen Gästebucheintrag für riesi

Beiträge: 986
Registriert: 06.05.2002

SWX Office Pre. 2013-Sp5
OneSpaceDrafting V18.1 M050
MS-Windows 7 Prof. 64Bit
Core i7-3820 @ 3.60 GHz
16,00 GB RAM
Nvidia Quadro FX 4000

erstellt am: 22. Sep. 2022 07:33    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Fränky77 10 Unities + Antwort hilfreich

Dein Beitrag steht in PDM Workgroup drin, es liest sich aber so, als meintest Du PDM Professional. Sehe ich das richtig? Es gibt die Rubrik "SolidWorks Enterprise PDM".

An welcher Stelle klemmt es denn genau?

Gruß, Klaus.

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

Fränky77
Mitglied
Konstrukteur

Sehen Sie sich das Profil von Fränky77 an!   Senden Sie eine Private Message an Fränky77  Schreiben Sie einen Gästebucheintrag für Fränky77

Beiträge: 3
Registriert: 20.09.2022

erstellt am: 22. Sep. 2022 07:40    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hi Klaus,
da hast du recht. Da ich noch einwenig unbedarft mitdem Thema bin. Soll ich es in "SolidWorks Enterprise PDM" nochmals eröffnen?

Mein Problem besteht darin. Das ich nicht alle Dateien als "Vorhanden" zurückbekomme. Die Dateien liegen alle im PDM Ordner Wir haben verschiedenen Hauptornder mit mehreren Unterordnern. Den einen "Weg" liest es aus aber nicht den anderen.
Viele Grüße
Frank

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

riesi
Mitglied
Konstrukteur, CAD-Admin


Sehen Sie sich das Profil von riesi an!   Senden Sie eine Private Message an riesi  Schreiben Sie einen Gästebucheintrag für riesi

Beiträge: 986
Registriert: 06.05.2002

SWX Office Pre. 2013-Sp5
OneSpaceDrafting V18.1 M050
MS-Windows 7 Prof. 64Bit
Core i7-3820 @ 3.60 GHz
16,00 GB RAM
Nvidia Quadro FX 4000

erstellt am: 22. Sep. 2022 08:05    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Fränky77 10 Unities + Antwort hilfreich

Besser wäre es, um die Reichweite zu erhöhen. Workgroup ist seit einigen SolidWorks-Versionen eingestellt und wenn andere Foren-Teilnehmer diese Gruppe nicht im Abo haben, geht Deine Frage unter.

Vielleicht kann der Admin diesen Thread verschieben?

Zur Sache selber: Ich würde die Api-Funktion des PDM nutzen.

1) Such-Funktion (IEdmSearch5 und IEdmSearchResult) einbauen
2) Schleife über das Such-Ergebnis einbauen, um die Export-Formate zu finden.
3) Mit IEdmVersion5 und der Methode GetFileCopy die gewünschten Dateien in den Export-Ordner kopieren.

Für PDF-Dateien habe ich es gemacht, müsstest Du für Dich anpassen:

Code:
Function pdfcopypdm(PdfFile As String, PDFPath As String) As Boolean

Dim message           As String
Dim myVault           As New EdmVault5
Dim search            As IEdmSearch7
Dim result            As IEdmSearchResult5
Dim epdmFolder        As IEdmFolder5
Dim epdmfile          As IEdmFile17

Dim boolstatus   As Boolean
Dim DesiredFile  As String
Dim ModelName    As String
Dim ModelPath    As String
Dim NewFileName  As String

Dim longstatus As Long, longwarnings As Long, longerrors As Long

pdfcopypdm = False
myVault.LoginAuto "PDM", 0

Set search = myVault.CreateUtility(EdmUtility.EdmUtil_Search)
search.Clear

search.FindFolders = False
search.FindFiles = True
search.FileName = PdfFile & ".pdf"
search.Recursive = True

Set result = search.GetFirstResult

i = 0

While Not result Is Nothing And i < 2
   Set epdmFolder = myVault.GetObject(EdmObjectType.EdmObject_Folder, result.ParentFolderID)
   Set epdmfile = myVault.GetObject(EdmObjectType.EdmObject_File, result.Id)
   ModelName = result.Name
   ModelPath = result.Path
   FolderID = result.ParentFolderID
   ModelID = result.Id
   i = i + 1
   Dim oEnumVersion As IEdmEnumeratorVersion7
   Set oEnumVersion = epdmfile
   Call oEnumVersion.GetFileCopy(0, epdmfile.CurrentVersion, PDFPath, EdmGetFlag.EdmGet_ForPreview, epdmfile.Name)
   pdfcopypdm = True
   Set result = search.GetNextResult()
Wend

Set lFile = Nothing
Set epdmfile = Nothing
Set epdmFolder = Nothing
Set result = Nothing
Set search = Nothing
Set myVault = Nothing

End Function


[Diese Nachricht wurde von riesi am 22. Sep. 2022 editiert.]

[Diese Nachricht wurde von riesi am 22. Sep. 2022 editiert.]

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

Fränky77
Mitglied
Konstrukteur

Sehen Sie sich das Profil von Fränky77 an!   Senden Sie eine Private Message an Fränky77  Schreiben Sie einen Gästebucheintrag für Fränky77

Beiträge: 3
Registriert: 20.09.2022

erstellt am: 22. Sep. 2022 17:40    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo Klaus ,
vielen vielen Dank für deine Hilfe.
Leider kenne ich mich in API nicht aus...
Werde das Thema nochmals in dem Forum  "SolidWorks Enterprise PDM" starten.

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

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2022 CAD.de | Impressum | Datenschutz