---

Guten Tag zusammen,
ich bin weiter dabei mich in die VBA-Programmierung einzuarbeiten und habe zu einem kleinen Programm ein par Fragen - Folgender Code Exporttiert mir eine Step Datei in einen bestimmten Ordner mit dem Dateinnamen zusammengesetzt aus Modellnummer und REvesionsnummer. Diese sind leider nur bekannt wenn die Datei schon einmal in unserer Datenbank abgespeichert war. Dateien die nur local gespeichert worden und diesen Eintrag nicht in den Iprops haben, führen zu Fehlermeldung und werden nicht gespeichert! Frage wie kann ich das Programm dazu bringen mir auch locale gespeicherte Daten mit dem Dateinamen (ohne Revesionsnummer) in diesen Ordner zu Exportieren und das Auslesen von den Iprops nur dan zu machen wenn diese vorhanden sind.

Im folgenden das Programm:
Sub StepExport()

If ThisApplication.Documents.Count = 0 Then
        MsgBox "Kein Dokument offen", 16, "Error"
Exit Sub
   
    End If
   
Dim dDoc As Object

Dim fso As Object
Set fso = CreateObject("Scripting.FilesystemObject")

Dim ret As Variant
Set dDoc = ThisApplication.ActiveDocument

Dim oModNr As Inventor.Property
Set oModNr = dDoc.PropertySets(4).Item("Modellnummer")

Dim oRevNr As Inventor.Property
Set oRevNr = dDoc.PropertySets(4).Item("Index")

If dDoc Is Nothing Then Exit Sub
If Len(Trim(dDoc.FullFileName)) > 0 Then
    outfile = "C:\Exchange\" & "\" & oModNr.Value & "_" & oRevNr.Value & ".step"
    dDoc.SaveAs outfile, True
Else
        MsgBox "Erst Speichern", vbInformation
End If
MsgBox "STEP wurde erfolgreich unter  - C:\Exchange - gespeichert"
End Sub

Danke für alle Hilfen

------------------
MFG

BlueJay

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

---

Hallo

Auf die Schnelle:

Code:

---

On error resume next
Set oRevNr = dDoc.PropertySets(4).Item("Index")

If dDoc Is Nothing Then Exit Sub
If Len(Trim(dDoc.FullFileName)) > 0 Then
    if oRevNr is nothing then
        outfile = "C:\Exchange\" & "\" & oModNr.Value & "_" & ".step"
    else
        outfile = "C:\Exchange\" & "\" & oModNr.Value & "_" & oRevNr.Value & ".step"
    end if
    dDoc.SaveAs outfile, True
Else
        MsgBox "Erst Speichern", vbInformation
End If
MsgBox "STEP wurde erfolgreich unter  - C:\Exchange - gespeichert"
End Sub

---

------------------
MfG
Ralf

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

---

Danke vielmals,
einen ähnlichen Weg habe ich auch schon versucht, aber diese benutzerdefinierten Eigenschaften wie Modellnummer und Index sind nach einem lokalen Speichern noch nicht in den Iproperties eingetragen - damit wird dieser Zusammenbau des Dateinames leider nicht funktionieren - werde noch mal darübernachdenken - Danke

Gruss

------------------
MFG

BlueJay

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

---

Hi

Sorry, hab überlesen das das zweite Propertie auch nicht gefüllt ist. 

Kann leider grad den Code nicht testen, hoffentlich paßt es. Als Dateiname wird einfach der Dateiname des Originals hergenommen.

Code:

---

Sub StepExport()

If ThisApplication.Documents.Count = 0 Then
        MsgBox "Kein Dokument offen", 16, "Error"
Exit Sub
 
    End If
 
Dim dDoc As Object

Dim fso As Object
Set fso = CreateObject("Scripting.FilesystemObject")

Dim ret As Variant
Set dDoc = ThisApplication.ActiveDocument

Dim oModNr As Inventor.Property
Set oModNr = dDoc.PropertySets(4).Item("Modellnummer")

Dim oRevNr As Inventor.Property
On Error Resume Next
Set oRevNr = dDoc.PropertySets(4).Item("Index")

If dDoc Is Nothing Then Exit Sub
If Len(Trim(dDoc.FullFileName)) > 0 Then
    If oRevNr Is Nothing Then
        Dim FullDocName As String
        oFulldocName = dDoc.FullDocumentName
        Dim oArray() As String
        oArray = Split(oFulldocName, "\")
        Dim sName As String
        sName = oArray(LBound(oArray))
        sName = Left(sName, Len(sName) - 4)
        outfile = "C:\Exchange\" & "\" & sName & ".step"
    Else
        outfile = "C:\Exchange\" & "\" & oModNr.Value & "_" & oRevNr.Value & ".step"
    End If
    dDoc.SaveAs outfile, True
Else
        MsgBox "Erst Speichern", vbInformation
End If
MsgBox "STEP wurde erfolgreich unter  - C:\Exchange - gespeichert"
End Sub

---

------------------
MfG
Ralf

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

---

Guten Morgen und vielen Dank,
habe wieder was dazu gelernt - ein kleiner Fehler war noch in dem Scipt und zwar:

sName = oArray(LBound(oArray))

geändert in

sName = oArray(UBound(oArray))

und dann hats funktioniert

Danke noch mal

------------------
MFG

BlueJay

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