AnsweredAssumed Answered

Can't find DLL entry point PathIsRelativeA in shlwapi.dll.

Question asked by Eddie Pellegrin on Aug 2, 2017
Latest reply on Aug 2, 2017 by Christian Chu

We have a custom task set up to export our drawings to .pdfs. We usually have it set to execute on a stand-alone machine, but that machine is currently down. I decided to set the execution method to my machine for the time being, but it stops and spits out this error. We used to run the .pdf tasks on the local machines in the past and it worked fine, but this is the first time in a while we have tried it again. Any help would be greatly appreciated.

 

2017-08-02_0842.png

 

The debugger stops on this line below.

If PathIsRelative( errorLogFolder ) = 1 Then

_______________________________________________________________

 

Dim swApp As Object

Dim swModel As SldWorks.ModelDoc2

Dim swDrawing As SldWorks.DrawingDoc

Dim swAssembly As SldWorks.AssemblyDoc

Dim swExtension As SldWorks.ModelDocExtension

Dim swConfMgr As SldWorks.ConfigurationManager

Dim swPDFExport As SldWorks.ExportPdfData

Dim swDocSpecification As SldWorks.DocumentSpecification

Dim FileSystemObj as Object

Dim errors As Long

Dim warnings As Long

 

 

#If VBA7 Then

    Private Declare PtrSafe Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" (ByVal hwnd As Long, ByVal pszPath As String, ByVal psa As Any) As Long

    Private Declare PtrSafe Function PathIsRelative Lib "shlwapi.dll" Alias "PathIsRelativeA" (ByVal pszPath As String) As Long

#Else

    Private Declare Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" (ByVal hwnd As Long, ByVal pszPath As String, ByVal psa As Any) As Long

    Private Declare Function PathIsRelative Lib "shlwapi.dll" Alias "PathIsRelativeA" (ByVal pszPath As String) As Long

#End If

 

 

Function PathAppend(path, more) As String

    If Not Right(path, 1) = "\" Then

        path = path & "\"

    End If

    If Left(more, 1) = "\" Then

        more = Mid(more, 2)

    End If

    PathAppend = path & more

End Function

 

 

Sub Log(message)

    Dim errorLogFolder As String

    Dim errorLogPath As String

    ' Determine error log output path

    errorLogFolder = "[ErrorLogPath]"

   

    ' Trim \ from the start

    If Left(errorLogFolder, 1) = "\" Then

        errorLogFolder = Mid(errorLogFolder, 2)

    End If

 

 

    ' Build full root

    If PathIsRelative( errorLogFolder ) = 1 Then

        errorLogPath = PathAppend("<VaultPath>", errorLogFolder)

    Else

        errorLogPath = errorLogFolder

    End If

   

    ' Create directory if not exists

    SHCreateDirectoryEx ByVal 0&, errorLogPath, ByVal 0&

    errorLogPath = PathAppend(errorLogPath, "<TaskInstanceGuid>.log")

 

 

    ' Write error to output file

    Open errorLogPath For Append As #1

    Print #1, message

    Close #1

End Sub

 

 

Sub CreatePath(path)

    ' Create directory if not exists

    If SHCreateDirectoryEx(ByVal 0&, path, ByVal 0&) = 0 Then

        ' Create temp file

        Open path & "~$holder" For Append As #1

        Close #1

    End If

End Sub

 

 

Sub KillHolder(path)

    On Error Goto Ignore

   If FileSystemObj.FileExists(path & "~$holder") Then

      Kill path & "~$holder"

   End If

Ignore:

End Sub

 

 

Function GetExtension(docType, fileFormat)

    first = InStr(1, fileFormat, "(")

    last = InStr(first, fileFormat, ")")

    extensions = Mid(fileFormat, first + 1, last - first - 1)

   

    If InStr(1, extensions, ";") > 0 Then

        Dim all As Variant

        all = Split(extensions, ";")

      

        If UBound(all) >= docType - 1 Then

            ext = all(docType - 1)

        Else

            ext = "*." ' Nothing

        End If

    Else

        ext = extensions

    End If

   

    GetExtension = Mid(Trim(ext), 2)

End Function

 

 

Sub SetConversionOptions(ext)

    ' PDF options

    If LCase(ext) = ".pdf" Then

        swApp.SetUserPreferenceToggle swPDFExportInColor, [PdfInColor]

        swApp.SetUserPreferenceToggle swPDFExportEmbedFonts, [PdfEmbedFonts]

        swApp.SetUserPreferenceToggle swPDFExportHighQuality, [PdfHighQuality]

        swApp.SetUserPreferenceToggle swPDFExportPrintHeaderFooter, [PdfPrintHeaderFooter]

        swApp.SetUserPreferenceToggle swPDFExportUseCurrentPrintLineWeights, [PdfUsePrinterLineWeights]

    ' IGES

    ElseIf LCase(ext) = ".igs" Then

        swApp.SetUserPreferenceToggle swIGESExportSolidAndSurface, [IgesExportSolidSurface]

        swApp.SetUserPreferenceIntegerValue swIGESRepresentation, [IgesRepresentation]

        swApp.SetUserPreferenceToggle swIGESExportAsWireframe, [IgesExportWireframe]

        swApp.SetUserPreferenceIntegerValue swIGESCurveRepresentation, [IgesCurveRepresentation]

        swApp.SetUserPreferenceIntegerValue swIGESSystem, [IgesSystem]

        swApp.SetUserPreferenceToggle swIGESExportFreeCurves, [IgesExportFreeCurves]

        swApp.SetUserPreferenceToggle swIGESExportSketchEntities, [IgesExportSketchEntities]

        swApp.SetUserPreferenceToggle swIGESHighTrimCurveAccuracy, [IgesHighCurveAccuracy]

        swApp.SetUserPreferenceToggle swIGESComponentsIntoOneFile, [IgesComponentsIntoOneFile]

        swApp.SetUserPreferenceToggle swIGESFlattenAssemHierarchy, [IgesFlattenAssemblyHierarchy]

    ' ACIS

    ElseIf LCase(ext) = ".sat" Then

        swApp.SetUserPreferenceIntegerValue swAcisOutputGeometryPreference, [AcisGeometry]

        swApp.SetUserPreferenceIntegerValue swOutputVersion, [AcisVersion]

        swApp.SetUserPreferenceIntegerValue swAcisOutputUnits, [AcisOutputAsUnit]

    ' STEP

    ElseIf LCase(ext) = ".step" Then

        swApp.SetUserPreferenceIntegerValue swAcisOutputGeometryPreference, [StepGeometry]

        swApp.SetUserPreferenceIntegerValue swStepAP, [StepVersion]

    ' Parasolid

    ElseIf LCase(ext) = ".x_t" Or LCase(ext) = ".x_b" Then

        swApp.SetUserPreferenceIntegerValue swParasolidOutputVersion, [ParasolidVersion]

        swApp.SetUserPreferenceToggle swXTAssemSaveFormat, [ParasolidFlattenHierarchy]

    ' VRML

    ElseIf LCase(ext) = ".wrl" Then

        swApp.SetUserPreferenceIntegerValue swExportVrmlUnits, [VrmlOutputAsUnit]

        swApp.SetUserPreferenceToggle swExportVrmlAllComponentsInSingleFile, [VrmlSaveAssemblyAsOneFile]

    ' STL

    ElseIf LCase(ext) = ".stl" Then

        swApp.SetUserPreferenceToggle swSTLBinaryFormat, [StlOutputAs]

        swApp.SetUserPreferenceIntegerValue swExportStlUnits, [StlOutputAsUnit]

        swApp.SetUserPreferenceIntegerValue swSTLQuality, [StlQuality]

        swApp.SetUserPreferenceToggle swSTLDontTranslateToPositive, [StlDontTranslatePositive]

        swApp.SetUserPreferenceToggle swSTLComponentsIntoOneFile, [StlComponentsIntoOneFile]

        swApp.SetUserPreferenceToggle swSTLCheckForInterference, [StlCheckForInterferences]

    ' TIF or PSD

    ElseIf LCase(ext) = ".tif" Or LCase(ext) = ".psd" Then

        swApp.SetUserPreferenceIntegerValue swTiffImageType, [TifImageType]

        swApp.SetUserPreferenceIntegerValue swTiffCompressionScheme, [TifCompressionScheme]

    ' eDrawings

    ElseIf LCase(ext) = ".eprt" Or LCase(ext) = ".easm" Or LCase(ext) = ".edrw" Then

        swApp.SetUserPreferenceToggle swEDrawingsOkayToMeasure, [EdrwOkayToMeasure]

        swApp.SetUserPreferenceToggle swEDrawingsExportSTLOkay, [EdrwAllowExportOfSTL]

        swApp.SetUserPreferenceToggle swEDrawingsSaveShadedDataInDrawings, [EdrwSaveShadedData]

        swApp.SetUserPreferenceToggle swEDrawingsSaveBOM, [EdrwSaveBOM]

        swApp.SetUserPreferenceToggle swEDrawingsSaveAnimationOkay, [EdrwSaveMotionStudies]

        swApp.SetUserPreferenceToggle swEDrawingsSaveAnimationToAllConfigs, [EdrwSaveMotionStudiesToAllConfs]

        swApp.SetUserPreferenceToggle swEDrawingsSaveAnimationRecalculate, [EdrwRecalcMotionStudies]

    End If

End Sub

 

 

Function GetFullFileName(convFileName, conf, i, itemCount)

    ' Configuration name may include backslash. Remove it since otherwise saving will

    ' fail due a missing directory

    conf = Replace(conf, "\", "")

    conf = Replace(conf, "/", "")

   

    finalFileName = Replace(convFileName, "<Configuration>", conf)

   

    ' If no configuration

    If finalFileName = convFileName And itemCount > 0 Then

        finalFileName = Left(convFileName, InStrRev(convFileName, ".") - 1) & "_" & i & Mid(convFileName, InStrRev(convFileName, "."))

    End If

   

    ' Remove illegal characters from filename

    finalFileName = Replace(finalFileName, "<", "")

    finalFileName = Replace(finalFileName, ">", "")

    finalFileName = Left(finalFileName, 2) + Replace(finalFileName, ":", "", 3) ' Don't start from begin since drive has :

    finalFileName = Replace(finalFileName, "*", "")

    finalFileName = Replace(finalFileName, "?", "")

    finalFileName = Replace(finalFileName, """", "")

    finalFileName = Replace(finalFileName, "|", "")

   

    GetFullFileName = finalFileName

End Function

 

 

Sub Convert(docFileName)

   

    ' Constants for some SolidWorks error/warning returns that may be encountered during a convert operation.       

    Const swerr_InvalidFileExtension = 256   ' the file extension differs from the SW document type.

    Const swerr_SaveAsNotSupported = 4096    ' the options selected for this convert aren't supported, output may be incomplete.

    Const swwarn_MissingOLEObjects = 512     ' the document contains OLE objects and must be opened and converted in SolidWorks.

 

 

    ' Determine type of SolidWorks file based on file extension

    If LCase(Right(docFileName, 7)) = ".sldprt" Or LCase(Right(docFileName, 4)) = ".prt" Then

        docType = swDocPART

    ElseIf LCase(Right(docFileName, 7)) = ".sldasm" Or LCase(Right(docFileName, 4)) = ".asm" Then

        docType = swDocASSEMBLY

    ElseIf LCase(Right(docFileName, 7)) = ".slddrw" Or LCase(Right(docFileName, 4)) = ".drw" Then

        docType = swDocDRAWING

    Else

        docType = swDocNONE

         If bIsSupportedExtension(Mid(docFileName, InStrRev(docFileName, ".") + 1)) = False Then

             Log "The file extension '" & Mid(docFileName, InStrRev(docFileName, ".") + 1) & "' is not supported."

             Exit Sub

         End If       

    End If

       

    ' Open document

    If docType = swDocNONE Then

        Set swModel = swApp.LoadFile4(docFileName, "", Nothing, errors)

        docType = swModel.GetType

    Else 

        Set swDocSpecification = swApp.GetOpenDocSpec(docFileName)

        swDocSpecification.DocumentType = docType

        swDocSpecification.ReadOnly = True

        swDocSpecification.Silent = True

        swDocSpecification.ConfigurationName = ""

        swDocSpecification.DisplayState = ""

        Set swModel = swApp.OpenDoc7(swDocSpecification)

        errors = swDocSpecification.Error

 

 

       ' Set swModel = swApp.OpenDoc6(docFileName, docType, swOpenDocOptions_Silent Or swOpenDocOptions_ReadOnly, "", errors, warnings)

    End If

   

    If errors = swFutureVersion Then

        Log "Document '" & docFileName & "' is future version."

        Exit Sub

    End If

 

 

    ' Load failed?

    If swModel Is Nothing Then

        Log "Method call ModelDoc2::OpenDoc7 for document '" & docFileName & "' failed. Error code " & errors & " returned."

        Exit Sub

    End If

   

    If Val(Left(swApp.RevisionNumber, 2)) >= 18 Then

      swApp.Frame.KeepInVisible = True

    End If

 

 

    swApp.ActivateDoc2 docFileName, True, errors

    modelPath = swModel.GetPathName()

    If modelPath = "" Then

      modelPath = docFileName

    End If

    modelFileName = Mid(modelPath, InStrRev(modelPath, "\") + 1)

    modelFileName = Left(modelFileName, InStrRev(modelFileName, ".") - 1)

    modelExtension = Mid(modelPath, InStrRev(modelPath, ".") + 1)

 

 

    ' Build destination filenames

    convFileName = "[OutputPath]"

   

    Dim convFileName2 As String

    convFileName2 = "[OutputPath2]"

    Dim convFilePath2 As String

    Dim convFileNameTemp2 As String

   

    Dim bSecondOutput As Boolean

    bSecondOutput = False

    If (Len(convFileName2) > 0) Then

        bSecondOutput = True

    End If

       

    ext = GetExtension(docType, "[FileFormat]")

   

    convFileName = Replace(convFileName, "<Filename>", modelFileName)

    convFileName = Replace(convFileName, "<Extension>", modelExtension)

 

 

    convFilePath = Left(convFileName, InStrRev(convFileName, "\"))

    CreatePath convFilePath

    convFileName = convFileName & ext

   

    If bSecondOutput = True Then

        convFileName2 = Replace(convFileName2, "<Filename>", modelFileName)

        convFileName2 = Replace(convFileName2, "<Extension>", modelExtension)

 

 

        convFilePath2 = Left(convFileName2, InStrRev(convFileName2, "\"))

        CreatePath convFilePath2

        convFileName2 = convFileName2 & ext

    End If

   

    ' Set conversion options

    SetConversionOptions ext

   

    Set swExtension = swModel.Extension

   

    If docType = swDocDRAWING Then

        Dim vSheetNames As Variant

        Set swDrawing = swModel

       

        ' All sheets?

        If ([OutputSheets] And 2) = 2 Then

            vSheetNames = swDrawing.GetSheetNames

        ' Last active sheet?

        ElseIf ([OutputSheets] And 4) = 4 Then

            ReDim vSheetNames(0 to 0) As Variant

            vSheetNames(0) = swDrawing.GetCurrentSheet.GetName()

        ' Named sheet

        ElseIf ([OutputSheets] And 8) = 8 Then

            Dim vSheetNamesTemp As Variant

            vSheetNamesTemp = swDrawing.GetSheetNames

            removed = 0

           

            For i = 0 To UBound(vSheetNamesTemp)

                vSheetNamesTemp(i-removed) = vSheetNamesTemp(i)

                sheetName = vSheetNamesTemp(i)

               

                If Not sheetName Like "[NamedSheet]" Then

                    removed = removed + 1

                EndIf

            Next i

           

            If (UBound(vSheetNamesTemp) - removed) >= 0 Then

                ReDim Preserve vSheetNamesTemp(0 To (UBound(vSheetNamesTemp) - removed))

                vSheetNames = vSheetNamesTemp

            End If

        End If

 

 

        If Not IsEmpty(vSheetNames) Then

            ' Save sheets one per file

            If ([FileSheets] And 4) = 4 Then

                For i = 0 To UBound(vSheetNames)

                    Dim varSheetName        As Variant

                    swDrawing.ActivateSheet vSheetNames(i)

 

 

                    convFileNameTemp = GetFullFileName(convFileName, vSheetNames(i), i, UBound(vSheetNames))

 

 

                    If LCase(ext) = ".pdf" Then

                        Set swPDFExport = swApp.GetExportFileData(1)

                        varSheetName = vSheetNames(i)

                        swPDFExport.SetSheets swExportData_ExportSpecifiedSheets, varSheetName

                    ElseIf LCase(ext) = ".edrw" Then

                        swApp.SetUserPreferenceIntegerValue swEdrawingsSaveAsSelectionOption, swEdrawingSaveActive 

                    End If

 

 

                    ' Convert the document

                    Success = swExtension.SaveAs(convFileNameTemp, swSaveAsCurrentVersion, swSaveAsOptions_Silent, swPDFExport, errors, warnings)

                   

                    ' Save failed?

                    If Success = False Then

                        If errors = swerr_InvalidFileExtension Then

                            Log "The file '" & docFileName & "' and sheet '" &  vSheetNames(i) & "' can't be converted to the file extension '" & ext & "'."

                        Else

                            Log "Method call ModelDocExtension::SaveAs for document '" & convFileNameTemp & "' and sheet '" & vSheetNames(i) & "' failed. Error code " & errors & " returned."

                            If (((errors And swerr_SaveAsNotSupported) <> 0) And ((warnings And swwarn_MissingOLEObjects) <> 0)) Then

                                Log "This document contains OLE objects. Such objects can't be converted outside of SolidWorks. Please open the document and perform the conversion from SolidWorks."

                            End If

                        End if 

                    End If

                   

                    If bSecondOutput = True Then

                        convFileNameTemp2 = GetFullFileName(convFileName2, vSheetNames(i), i, UBound(vSheetNames))

                        Success = swExtension.SaveAs(convFileNameTemp2, swSaveAsCurrentVersion, swSaveAsOptions_Silent, swPDFExport, errors, warnings)

                        ' Save failed?

                        If Success = False Then

                            If errors = swerr_InvalidFileExtension Then

                                Log "The file '" & docFileName & "' and sheet '" &  vSheetNames(i) & "' can't be converted to the file extension '" & ext & "'."

                            Else

                                Log "Method call ModelDocExtension::SaveAs for document '" & convFileNameTemp2 & "' and sheet '" & vSheetNames(i) & "' failed. Error code " & errors & " returned."

                                If (((errors And swerr_SaveAsNotSupported) <> 0) And ((warnings And swwarn_MissingOLEObjects) <> 0)) Then

                                    Log "This document contains OLE objects. Such objects can't be converted outside of SolidWorks. Please open the document and perform the conversion from SolidWorks."

                                End If

                            End if

                        End If

                    End If

                Next i

            ' Save PDF sheets to one file

            ElseIf ([FileSheets] And 2) = 2 Then

           

                If LCase(ext) = ".pdf" Then

                    Set swPDFExport = swApp.GetExportFileData(swExportPdfData)

                    swPDFExport.SetSheets swExportData_ExportSpecifiedSheets, vSheetNames

                ElseIf LCase(ext) = ".edrw" Then

                    If ([OutputSheets] And 2) = 2 Then ' All sheets?

                        swApp.SetUserPreferenceIntegerValue swEdrawingsSaveAsSelectionOption, swEdrawingSaveAll

                    ElseIf ([OutputSheets] And 4) = 4 Then ' Last active sheet?

                        swApp.SetUserPreferenceIntegerValue swEdrawingsSaveAsSelectionOption, swEdrawingSaveActive 

                    ElseIf ([OutputSheets] And 8) = 8 Then ' Named sheet

                        swApp.SetUserPreferenceIntegerValue swEdrawingsSaveAsSelectionOption, swEdrawingSaveSelected

                        selectedSheets = Join(vSheetNames, vbLf)

                        swApp.SetUserPreferenceStringListValue swEmodelSelectionList, Trim(selectedSheets)

                    End If

                End If

               

                convFileNameTemp = GetFullFileName(convFileName, "All", 0, 0)

               

                ' Convert the document

                Success = swExtension.SaveAs(convFileNameTemp, swSaveAsCurrentVersion, swSaveAsOptions_Silent, swPDFExport, errors, warnings)

               

                ' Save failed?

                If Success = False Then

                    Log "Method call ModelDocExtension::SaveAs for document '" & convFileNameTemp & "' failed. Error code " & errors & " returned."

                End If

               

                If bSecondOutput = True Then

                    convFileNameTemp2 = GetFullFileName(convFileName2, "All", 0, 0)

                    Success = swExtension.SaveAs(convFileNameTemp2, swSaveAsCurrentVersion, swSaveAsOptions_Silent, swPDFExport, errors, warnings)

                    ' Save failed?

                    If Success = False Then

                        Log "Method call ModelDocExtension::SaveAs for document '" & convFileNameTemp2 & "' failed. Error code " & errors & " returned."

                    End If

                End If

            End If

        Else

            Log "Document '" & docFileName & "' didn't contain any sheets named '[NamedSheet]'."

        End If

    Else

        Dim vConfNames As Variant

        Set swConfMgr = swModel.ConfigurationManager

       

        ' All configurations?

        If ([OutputConfs] And 2) = 2 Then

            vConfNames = swModel.GetConfigurationNames

        ' Last active conf?

        ElseIf ([OutputConfs] And 4) = 4 Then

            ReDim vConfNames(0 to 0) As Variant

            vConfNames(0) = swConfMgr.ActiveConfiguration.Name

        ' Named confs

        ElseIf ([OutputConfs] And 8) = 8 Then

            Dim vConfNamesTemp As Variant

            vConfNamesTemp = swModel.GetConfigurationNames

            removed = 0

           

            For i = 0 To UBound(vConfNamesTemp)

                vConfNamesTemp(i-removed) = vConfNamesTemp(i)

                confName = vConfNamesTemp(i)

               

                If Not confName Like "[NamedConf]" Then

                    removed = removed + 1

                EndIf

            Next i

           

            If (UBound(vConfNamesTemp) - removed) >= 0 Then

                ReDim Preserve vConfNamesTemp(0 To (UBound(vConfNamesTemp) - removed))

                vConfNames = vConfNamesTemp

            End If

        End If

       

        If Not IsEmpty(vConfNames) Then

            If ([FileConfs] And 4) = 4 Then

                ' Save configurations

                For i = 0 To UBound(vConfNames)

                    swModel.ShowConfiguration vConfNames(i)

 

 

                    convFileNameTemp = GetFullFileName(convFileName, vConfNames(i), i, UBound(vConfNames))

 

 

                    ' Convert the document

                    Success = swExtension.SaveAs(convFileNameTemp, swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, errors, warnings)

               

                    ' Save failed?

                    If Success = False Then

                        If errors = swerr_InvalidFileExtension Then

                            Log "The file '" & docFileName & "' and configuration '" & vConfNames(i) & "' can't be converted to the file extension '" & ext & "'."

                        Else

                            Log "Method call ModelDocExtension::SaveAs for document '" & convFileNameTemp & "' and configuration '" & vConfNames(i) & "' failed. Error code " & errors & " returned."

                            If (((errors And swerr_SaveAsNotSupported) <> 0) And ((warnings And swwarn_MissingOLEObjects) <> 0)) Then

                                Log "This document contains OLE objects. Such objects can't be converted outside of SolidWorks. Please open the document and perform the conversion from SolidWorks."

                            End If

                        End If

                    End If

                   

                    If bSecondOutput = True Then

                        convFileNameTemp2 = GetFullFileName(convFileName2, vConfNames(i), i, UBound(vConfNames))

                        Success = swExtension.SaveAs(convFileNameTemp2, swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, errors, warnings)

                        ' Save failed?

                        If Success = False Then

                            If errors = swerr_InvalidFileExtension Then

                                Log "The file '" & docFileName & "' and configuration '" & vConfNames(i) & "' can't be converted to the file extension '" & ext & "'."

                            Else

                                Log "Method call ModelDocExtension::SaveAs for document '" & convFileNameTemp2 & "' and configuration '" & vConfNames(i) & "' failed. Error code " & errors & " returned."

                                Log "warnings1 = " & warnings

                                If (((errors And swerr_SaveAsNotSupported) <> 0) And ((warnings And swwarn_MissingOLEObjects) <> 0)) Then

                                    Log "This document contains OLE objects. Such objects can't be converted outside of SolidWorks. Please open the document and perform the conversion from SolidWorks."

                                End If

                            End If

                        End If

                    End If

                Next i

            ElseIf ([FileConfs] And 2) = 2 Then

                If LCase(ext) = ".eprt" Or LCase(ext) = ".easm" Then

                    If ([OutputConfs] And 2) = 2 Then ' All confs?

                        swApp.SetUserPreferenceIntegerValue swEdrawingsSaveAsSelectionOption, swEdrawingSaveAll

                    ElseIf ([OutputConfs] And 4) = 4 Then ' Last active conf?

                        swApp.SetUserPreferenceIntegerValue swEdrawingsSaveAsSelectionOption, swEdrawingSaveActive 

                    ElseIf ([OutputConfs] And 8) = 8 Then ' Named confs

                        swApp.SetUserPreferenceIntegerValue swEdrawingsSaveAsSelectionOption, swEdrawingSaveSelected

                        selectedConfs = Join(vConfNames, vbLf)

                        swApp.SetUserPreferenceStringListValue swEmodelSelectionList, Trim(selectedConfs)

                    End If

                End If

               

                convFileNameTemp = GetFullFileName(convFileName, "All", 0, 0)

               

                ' Convert the document

                Success = swExtension.SaveAs(convFileNameTemp, swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, errors, warnings)

               

                ' Save failed?

                If Success = False Then

                    Log "Method call ModelDocExtension::SaveAs for document '" & convFileNameTemp & "' failed. Error code " & errors & " returned."

                End If

               

                If bSecondOutput = True Then

                    convFileNameTemp2 = GetFullFileName(convFileName2, "All", 0, 0)

                    Success = swExtension.SaveAs(convFileNameTemp2, swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, errors, warnings)

                    ' Save failed?

                    If Success = False Then

                        Log "Method call ModelDocExtension::SaveAs for document '" & convFileNameTemp2 & "' failed. Error code " & errors & " returned."

                    End If

                End If

            End If

        Else

            Log "Document '" & docFileName & "' didn't contain any configurations named '[NamedConf]'."

        End If

    End If

   

    KillHolder convFilePath

    KillHolder convFilePath2

   

    ' Process virtual components

    If docType = swDocASSEMBLY Then

        Dim vComponents As Variant

        Set swAssembly = swModel

       

        vComponents = swAssembly.GetComponents(True)

       

        If Not IsEmpty(vComponents) Then

          For i = 0 To UBound(vComponents)

              Dim swComponent As SldWorks.Component2

              Set swComponent = vComponents(i)

             

              If swComponent.IsVirtual Then

                  Convert swComponent.GetPathName()

              End If

          Next i

      End If

    End If

 

 

    ' Close document

    swApp.QuitDoc swModel.GetTitle

End Sub

 

 

Function bIsSupportedExtension(oExtension) As Boolean

   

    oExtension = LCase( oExtension )

   

    If oExtension = "prt" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "asm" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "drw" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "dxf" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "dwg" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "psd" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "ai" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "lfp" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "sldlfp" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "prtdot" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "asmdot" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "drwdot" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "x_t" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "x_b" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "xmt_txt" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "xmt_bin" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "igs" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "iges" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "step" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "stp" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "sat" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "vda" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "wrl" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "stl" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "cgr" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "wrl" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "xpr" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "xas" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "ipt" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "iam" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "par" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "psm" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "ckd" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "emn" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "brd" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "bdf" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "idb" Then

       bIsSupportedExtension = True

    ElseIf oExtension = "3dm" Then

       bIsSupportedExtension = True

    Else

        bIsSupportedExtension = False

    End If

      

End Function

 

 

Sub main()

   

    On Error GoTo Fail:

 

 

    Set FileSystemObj = CreateObject("Scripting.FileSystemObject")

    docFileName = "<Filepath>"

   

    ' Get SW interface object

    Set swApp = Application.SldWorks

    swApp.Visible = True

    Convert docFileName

   

    Exit Sub

      

Fail:

    Log "Error while converting file '" & docFileName & "': " & vbCrLf & _

        "An unexpected error occurred while executing the generated script. Script syntax error?" & vbCrLf & _

        "Error number: " & Err.Number & vbCrLf & _

        "Error description: '" & Err.Description & "'" & vbCrLf

       

End Sub

Outcomes