VBA 2011 -> 2014 (Autodesk/Inventor VBA)

Edit:
Ok der Code scheint unten Ok zu sein habe jetzt den Fehler eingegrenzt:
Ich habe eine Funktion die mir den Pfad auswählen lässt, so windows Speichern unter in der Art
Und genau diese Funktion Crashed:
Den Code habe ich kopiert wie man sieht also kenne ich mich damit leider nicht aus, hat jemand eine aktuelle version vl für IV 2014?
Hier glaube ich habe ich den Code her http://www.vbarchiv.net/workshop/workshop_5-ordnerauswahl-dialog-in-vb.html

Code:

' ###########################################
'
' MODUL "FolderBrowse"
'
' (c) Ingo Steinhaus 2000
' ingo.steinhaus@gmx.de
'
' Funktionen zur Anzeige des Windows-Standardialogs zur Auswahl
' eines Ordners auf dem aktiven Rechner oder im Netzwerk.
'
' Dieses Modul ist urheberrechtlich geschützte Freeware.
' Die originale Copyright-Meldung darf nicht entfernt oder ver-
' ändert werden. Der Quelltext darf nicht verändert werden.
'
'###########################################

Private Const MAX_PATH = 260

' *********************************************************
' Die Datenstruktur "BrowseInfo" dient der Konfiguration
' des Folder-Browse-Dialogs.

Private Type BrowseInfo
hWndOwner As Long
' Handle des Besitzers (mit GetActiveWindow() abfragen)
pIDLRoot As Long
' Adresse der IID-Liste.
'Sie gibt die Position des Wurzelordners an, der als
'Baumwurzel im Browse-Dialog erscheint. Nur dieser
'Ordner und die davon abzweigenden Ordner erscheinen
'im Browse-Dialog.
'Sie können hier NULL eintragen; in diesem Fall wird
'der Desktop als Baumwurzel benutzt. Dadurch haben Sie
'Zugriff auf alle Laufwerke sowie die Netzwerkumgebung.
pszDisplayName As Long
' Adresse eines Puffers, der den Namen des vom Anwender
'ausgewählten Ordners (ohne Pfad) enthält. Der Puffer
'kann maximal 260 Zeichen enthalten (MAX_PATH Konstante)
lpszTitle As Long
' Adresse eines nullterminierten Strings, der über der
'Baumansicht gezeigt werden. Sie können diesen String
'für Informationen oder Anweisungen benutzen.
ulFlags As Long
' Flags, die die Anzeigeoptionen des Dialogfeldes bestimmen
lpfnCallback As Long
' Adresse einer Rückruffunktion, die in der Anwendung
'definiert wird.
'Sie können hier NULL eintragen.
lParam As Long
' Ein anwendungsdefinierter Wert, den das Dialogfeld an
'eine Rückruffunktion übergibt.
iImage As Long
' Eine Variable für das Bild, mit dem der ausgewählte Ordner
'in der Baumansicht gekennzeichnet ist. Die Variable enthält
'einen Index auf die Systembilderliste von Windows 95/98.
End Type

' *********************************************************
' Die folgenden Konstanten sind die erlaubten Werte für
' BrowseInfo->ulFlags.

Private Const BIF_BROWSEFORCOMPUTER = &H1000
' Nur Computer als Auswahl erlaubt. Wenn der Anwender andere
'Ordner markiert, kann der OK-Schalter nicht ausgewählt
'werden.

Private Const BIF_BROWSEFORPRINTER = &H2000
' Nur Drucker als Auswahl erlaubt. Wenn der Anwender andere
'Ordner markiert, kann der OK-Schalter nicht ausgewählt
'werden.

Private Const BIF_BROWSEINCLUDEFILES = &H4000
' Der Dialog zeigt neben den Ordnern auch Dateien.

Private Const BIF_DONTGOBELOWDOMAIN = &H2
' Der Dialog zeigt keine Netzwerkordner unterhalb der
'aktuellen Domain.

Private Const BIF_RETURNFSANCESTORS = &H8
' Nur Dateisystemobjekte als Auswahl erlaubt. Wenn der
'Anwender andere Ordner markiert, kann der OK-Schalter
'nicht ausgewählt werden.

Private Const BIF_RETURNONLYFSDIRS = &H1
' Nur Dateisystemordner als Auswahl erlaubt. Wenn der
'Anwender andere Ordner markiert, kann der OK-Schalter
'nicht ausgewählt werden.

Private Const BIF_STATUSTEXT = &H4
' Der Dialog enthält eine Statuszeile. Die Rückruffunktion
'kann die Statuszeile ausfüllen.

' *********************************************************
'*** CoTaskMemFree
' Eine Funktion zum Verwerfen von angefordertem globalen
' Speicher.

Private Declare PtrSafe Sub CoTaskMemFree Lib "ole32.dll" ( _
ByVal hMem As Long)

' *********************************************************
'*** lstrcat
' Eine Funktion zum Verknüpfen von nullterminierten Strings.

Private Declare PtrSafe Function lstrcat Lib "kernel32" _
Alias "lstrcatA" ( _
ByVal lpString1 As String, _
ByVal lpString2 As String) As Long

' *********************************************************
' *** GetActiveWindow
' Eine Funktion zum Ermitteln des Fenster-Handles.

Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As Long

' *********************************************************
' *** SHGetPathFromIDList
' Diese Funktion konvertiert eine IID-Liste in einen Pfad des
' Dateisystems.

Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32" ( _
ByVal pidList As Long, _
ByVal lpBuffer As String) As Long

' ********************************************************
Rem *** SHBrowseForFolder
Rem Diese Funktion ruft den Folder-Browse-Dialog auf.
Rem Der Aufrufer muß den Speicher der IID-Liste verwerfen.

Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32" ( _
lpbi As BrowseInfo) As Long

' *********************************************************
' *** BrowseForFolder
' Eine VB/VBA-Funktion als einfach zu nutzender Mantel für den
' Aufruf des Folder-Browse-Dialogs.

Public Function BrowseForFolder(Prompt As String) As String

Dim n As Integer
Dim IDList As Long
Dim Result As Long
Dim ThePath As String
Dim BI As BrowseInfo

' Erzeugen der Datenstruktur
With BI
' Handle des aktiven Fensters ermitteln
.hWndOwner = GetActiveWindow()
' Titel des Dialoges
.lpszTitle = lstrcat(Prompt, "")
' Nur Dateisystemordner erlaubt
.ulFlags = BIF_RETURNONLYFSDIRS
End With

' Anzeigen des Dialogs und Übergabe an eine IID-Liste
IDList = SHBrowseForFolder(BI)

' Wenn IDList > 0, dann Auswahl bearbeiten
If IDList Then
' Speicher anfordern
ThePath = String$(MAX_PATH, 0)
' IID-Liste in Pfadangabe konvertieren
Result = SHGetPathFromIDList(IDList, ThePath)
' Speicher für IID-Liste verwerfen
Call CoTaskMemFree(IDList)
' Alle Bytes hinter Nullbyte verwerfen
n = InStr(ThePath, vbNullChar)
If n Then ThePath = Left$(ThePath, n - 1)
End If

' Rückgabewert der Funktion definieren
BrowseForFolder = ThePath
End Function
Public Sub Browse()
TheFolder$ = BrowseForFolder("Wählen Sie einen Ordner aus.")
End Sub

Danke jetzt läuft meine Form wenigstens wieder und die hälfte der Funktionen.

Leider funktioniert nur das drucken, pdf und dwg erstellen nicht.

Hier mal der Code
Ich muss leider dazu sagen ich hab den Code damals (vor mehr als einem Jahr) aus mehreren Codeschnipseln zusammengepanscht und rumprobiert bis es irgendmal ging.
Wenn ich den Code laufen lasse Crashed mir IV einfach.
Daher weiß ich nicht wirklich was ich jetzt tuen soll

Code:

Public Sub Dev_PDF()
' Get the PDF translator Add-In.
Dim PDFAddIn As TranslatorAddIn
Set PDFAddIn = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}")
'Set a reference to the active document (the document to be published).
Dim oDocument As Document
Set oDocument = ThisApplication.ActiveDocument
Dim oContext As TranslationContext
Set oContext = ThisApplication.TransientObjects.CreateTranslationContext
oContext.Type = kFileBrowseIOMechanism
' Create a NameValueMap object
Dim oOptions As NameValueMap
Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap
' Create a DataMedium object
Dim oDataMedium As DataMedium
Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium
' Check whether the translator has 'SaveCopyAs' options
If PDFAddIn.HasSaveCopyAsOptions(oDocument, oContext, oOptions) Then
' Options for drawings...
oOptions.Value("All_Color_AS_Black") = 0
'oOptions.Value("Remove_Line_Weights") = 0
'oOptions.Value("Vector_Resolution") = 400
'oOptions.Value("Sheet_Range") = kPrintAllSheets
'oOptions.Value("Custom_Begin_Sheet") = 2
'oOptions.Value("Custom_End_Sheet") = 4
End If
Dim oDoc As Document
Dim Länge_Dateiname_mit_Pfad As Integer
Dim Name_Pfad As String
Dim Pfad_export As String
Dim Länge_String As Integer
Dim Dateiname_mit_Pfad As String
Set oDoc = ThisApplication.ActiveDocument

'____________________________________________________________________iProperties_______________________________________
' Get the PropertySets object.
Dim oPropSets As PropertySets
Set oPropSets = oDoc.PropertySets

' Get the design tracking property set.
Dim oPropSet As PropertySet
Set oPropSet = oPropSets.Item("Design Tracking Properties")

' Get the drawing number iProperty.
'Dim status As Property
'Set status = oPropSet.Item("User Status")
'Get the ipt status iProperty
'Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument
Dim oReferencedDoc As Document
On Error Resume Next
Set oReferencedDoc = oDrawDoc.ReferencedDocuments.Item(1)

Dim oPropValue As String
oPropValue = oReferencedDoc.PropertySets.Item("{32853F0F-3444-11D1-9E93-0060B03C1CA6}").Item("User Status").Value
'Display the value.
'MsgBox "The part number is: " & oPropValue
'______________________________________________________________________iProperties__________________________________________

Dateiname_mit_Pfad = oDoc.FullFileName
Länge_Dateiname_mit_Pfad = Len(Dateiname_mit_Pfad)
Dim Endung As Integer
'Endung = 0 'mit .ipt usw.
Endung = 4 ' ohne .ipt usw
Name_Pfad = Mid(Dateiname_mit_Pfad, 1, Länge_Dateiname_mit_Pfad - 4)
Länge_String = Len(Name_Pfad)

Dim i As Integer
i = 1
Do Until Mid(Name_Pfad, Länge_String - i, 1) = "\"
i = i + 1
Loop

'Dateiname = Right(Name_Pfad, i - Endung)
Dateiname = Right(Name_Pfad, i)
'MsgBox "Dateiname: " & Dateiname
Name_Pfad = Mid(Dateiname_mit_Pfad, 1, Länge_Dateiname_mit_Pfad - i)
'MsgBox "Dateiname : " & Dateiname & Chr(10) & "Pfad : " & Name_Pfad & Chr(10)
TheFolder$ = BrowseForFolder("Wählen Sie einen Ordner aus.")
'Set the destination file name
If oPropValue = "" Then
oDataMedium.FileName = TheFolder$ & "\" & Dateiname & ".pdf"
Else
oDataMedium.FileName = TheFolder$ & "\" & Dateiname & "_" & oPropValue & ".pdf"
End If
'MsgBox oDataMedium.FileName
'Publish document.
Call PDFAddIn.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium)
MsgBox "PDF Export abgeschlossen!", vbOKOnly, "PDF Erstellt!"
'MsgBox oDataMedium.FileName
Shell "C:\Program Files (x86)\Adobe\Reader 10.0\Reader\AcroRd32.exe " & oDataMedium.FileName, vbNormalFocus
End Sub

[Diese Nachricht wurde von axi92 am 12. Sep. 2013 editiert.]

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