Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  Solid Edge
  Baugruppe kopieren incl. Excel-Tabellen mit VB

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
  
Gut zu wissen: Importformate aus dem Windows Dateiexplorer heraus öffnen
Autor Thema:   Baugruppe kopieren incl. Excel-Tabellen mit VB (1218 mal gelesen)
Lemurian
Mitglied



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

Beiträge: 95
Registriert: 20.11.2002

PROCIM
Systemtechnik GmbH

erstellt am: 23. Mai. 2004 18:55    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,
mein Problem ist, das mit nachstehendem code das mehrfache kopieren eines asm in verschiedene Ordner problemlos funktioniert, solange es sich nur um SE-Dateien handelt. Wenn allerdings ein Exceltabelle mit dabei ist, kommt bei mir die insight-connect Meldung hoch, dass er den Status des Exceldokuments nicht ermitteln kann. Hätte jemand einen Tip für mich wie ich die zugehörigen Excel-Dokumente kopiert bekomme?

Public Sub ShowAssyStructure(ByVal Doc As RevisionManager.Document)

Dim i, a As Integer, j As Integer
Dim d As String
Dim k As Integer

Dim objLinkedDocs As RevisionManager.LinkedDocuments
Set objLinkedDocs = Doc.LinkedDocuments
'-------------------------------------------------------
For i = 1 To objLinkedDocs.Count
  MsgBox objLinkedDocs(i).FullName 'zum test
  k = Form1.lstAuswahl.ListCount - 1
    For j = 0 To k
      d = (Form2.txtPfad.Text & "\" & Form1.lstAuswahl.List(j))
      If fso.FolderExists(d) = True Then
        objLinkedDocs(i).Copy (d & "\" & DateinameOnly(objLinkedDocs(i).FullName)) 'kopieren des vorgegebenen neuen pfades und _
den jeweiligen dateinamen
      Else
        fso.CreateFolder (d)
        objLinkedDocs(i).Copy (d & "\" & DateinameOnly(objLinkedDocs(i).FullName))
      End If
    Next j

    If UCase(Right(objLinkedDocs(i).FullName, 3)) = "ASM" Then
      Call ShowAssyStructure(objLinkedDocs(i), d)
    End If
Next i
'----------------------------------------------------------
Set objLinkedDocs = Nothing
Set Doc = Nothing

End Sub


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

Jürgen Niesner
Mitglied



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

Beiträge: 505
Registriert: 26.11.2001

erstellt am: 24. Mai. 2004 12:51    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 Lemurian 10 Unities + Antwort hilfreich

Servus Lemurian,

für ein assy wird die SUB "ShowAssyStructure" recursiv aufgerufen. Beim recursiven Aufruf übergibts Du zwei Parameter "objLinkedDocs(i)" und "d". Der zweite Parameter aber in der definition der SUB nicht vorgesehen.

Weiterer Tip:
gib Deinen variablen sprechende Namen, mit mit kennzeichnung um welchen typ es sich handelt. z.B.:
Dim sPfad as String 'liest sich besser als d

Jürgen

------------------
50* SEV14SR13, 4* SEV15SR2

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

Lemurian
Mitglied



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

Beiträge: 95
Registriert: 20.11.2002

PROCIM
Systemtechnik GmbH

erstellt am: 24. Mai. 2004 13:44    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

args, ja stimmt, den habe ich bestimmt versehentlich drinnengelassen als ich die SUB fürs forum angepasst habe.
Also wie oben gesagt, das kopieren von assys mit unterassys funktioniert(e)  problemlos, es gibt halt nur das problem wenn excel-tabellen am asm mit dranhängen.
In dieser sub hatte ich vorher noch eine abfrage dabei, mit der ich das mitkopieren der Excel-Tabelle ausgeschlossen hatte.
Beim öffnen der Kopien mit SE-V14 ist dann aber das Problem, daß er die originale Excel-tabelle öffnet und Änderungen auf das modell der Kopie überträgt und das möchte ich jetzt vermeiden, in dem ich die Tabelle mitkopiere und somit die Bezüge die das asm auf die originale Exceltabelle hat auf die kopie der Excel-Tabelle gesetzt werden.

Public Sub ShowAssyStructure(ByVal Doc As RevisionManager.Document)

Dim i, a As Integer, j As Integer,k As Integer 'zaehlervariablen
Dim Speicherpfad As String 'zusamengesetzter speicherpfad
Dim objLinkedDocs As RevisionManager.LinkedDocuments

Set objLinkedDocs = Doc.LinkedDocuments
'-------------------------------------------------------
For i = 1 To objLinkedDocs.Count 'anzahl der verlinkten documente
  MsgBox objLinkedDocs(i).FullName 'nur zum test

  If UCase(Right(objLinkedDocs(i).FullName, 3)) <> "XLS" Then
    k = Form1.lstAuswahl.ListCount - 1
    For j = 0 To k
      Speicherpfad = Form2.txtPfad.Text & "\" & Form1.lstAuswahl.List(j)
      If fso.FolderExists(Speicherpfad) = True Then
        objLinkedDocs(i).Copy (Speicherpfad & "\" & DateinameOnly(objLinkedDocs(i).FullName)) 'kopieren der Dateien in die vorgegeben Ordner
      Else
        fso.CreateFolder (Speicherpfad)
        objLinkedDocs(i).Copy (Speicherpfad & "\" & DateinameOnly(objLinkedDocs(i).FullName))
      End If
    Next j

    If UCase(Right(objLinkedDocs(i).FullName, 3)) = "ASM" Then
      Call ShowAssyStructure(objLinkedDocs(i))
    End If

  End If
Next i'----------------------------------------------------------
Set objLinkedDocs = Nothing
Set Doc = Nothing

End Sub

Grüße Lemmi

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

Marco Kreutz
Mitglied



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

Beiträge: 632
Registriert: 11.02.2003

SolidEdge ST8, SolidWorks 2015, Inventor 2014, PRO/E Creo1 und Creo2
VB 6.0 / VB.NET / C#.NET
Windows 10 64bit

erstellt am: 24. Mai. 2004 21:29    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 Lemurian 10 Unities + Antwort hilfreich

Hallo,

warum alles neu durchleben wenn es schon Loesungen gibt.

Unser Programm HITTeam ist in Lage alle Dokumente solwohl Draft, OLE (Office Dokumente), Familien ... zu erkennen und zu kopieren.

Sie haben die Moeglichkeit sowohl in SolidEdge als auch im Explorer komplette Strukturen zu kopieren und das alles kostenlos.

Einfach mal probieren ...

------------------
Marco Kreutz
info@hitteam.de
www.hitteam.de

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

Lemurian
Mitglied



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

Beiträge: 95
Registriert: 20.11.2002

PROCIM
Systemtechnik GmbH

erstellt am: 24. Mai. 2004 22:49    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,
das stimmt schon, aber ich kann mich mit einem Programm vom HITTeam ganz schlecht vor eine Prüfungskomission stellen und es dort präsentieren.
Da muss ich schon etwas Eigenleistung erbringen 
Und bei dem Problem mit den oben angesprochenen Excel-Tabellen hänge ich im Moment gerade fest und komme auf keinen grünen Zweig.
Ich bin für jede hilfe dankbar 

Gruß Lemmi

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

Jürgen Niesner
Mitglied



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

Beiträge: 505
Registriert: 26.11.2001

erstellt am: 25. Mai. 2004 08:13    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 Lemurian 10 Unities + Antwort hilfreich

Servus Lemmi,

wenn ich Dein Problem richtig verstandne habe müßtest Du es wie folgt umgehen können:

Public Sub ShowAssyStructure(ByVal Doc As RevisionManager.Document)

Dim i, a As Integer, j As Integer, k As Integer 'zaehlervariablen
Dim Speicherpfad As String 'zusamengesetzter speicherpfad
Dim objLinkedDocs As RevisionManager.LinkedDocuments

Set objLinkedDocs = Doc.LinkedDocuments
'-------------------------------------------------------
For i = 1 To objLinkedDocs.Count 'anzahl der verlinkten documente
  MsgBox objLinkedDocs(i).FullName 'nur zum test

  If UCase(Right(objLinkedDocs(i).FullName, 3)) <> "XLS" Then
    k = Form1.lstAuswahl.ListCount - 1
    For j = 0 To k
      Speicherpfad = Form2.txtPfad.Text & "\" & Form1.lstAuswahl.List(j)
      If fso.FolderExists(Speicherpfad) = False Then
        'kopieren aus der If-Bedingung herausgenommen, da immer kopiert werden soll
        fso.CreateFolder (Speicherpfad)
      End If
      If UCase(Right(objLinkedDocs(i).FullName, 3)) = "XLS" Then        'wenn Excel-Dok
          fso.... Dateikopieren(sAlteExcel,sNeueExcel)                  'ohne RevMan kopieren
          objLinkedDocs(i).Replace (sNeueExcel)                        'und Link ändern
      Else                                                              'alles andere über RevMan
          objLinkedDocs(i).Copy (Speicherpfad & "\" & DateinameOnly(objLinkedDocs(i).FullName)) 'kopieren der Dateien in die vorgegeben Ordner
      End If
    Next j

    If UCase(Right(objLinkedDocs(i).FullName, 3)) = "ASM" Then
      Call ShowAssyStructure(objLinkedDocs(i))
    End If

  End If
Next i '----------------------------------------------------------
Set objLinkedDocs = Nothing
Set Doc = Nothing

End Sub

Jürgen

------------------
50* SEV14SR13, 4* SEV15SR2

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

Lemurian
Mitglied



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

Beiträge: 95
Registriert: 20.11.2002

PROCIM
Systemtechnik GmbH

erstellt am: 25. Mai. 2004 15:14    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 Jürgen,
deine Idee mit dem kopieren der Excel-Tabelle über das scripting Objekt und das anschließende ersetzen haben bei mir ein Licht aufgehen lassen 
Die 10 units sind mehr als verdient.

Gruß Lemmi

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)2020 CAD.de | Impressum | Datenschutz