如何克服CATIA.FileSelectionBox()错误而不设置" regserver选项"作为管理员?

时间:2017-06-19 23:45:52

标签: vba dialog catia

如果我有管理员权限,以下代码运行良好。但它对用户来说根本不起作用。

Sub CATMain()
On Error Resume Next
Dim strpath As String

strpath = CATIA.FileSelectionBox("Select file", "*.xlsx", 
CatFileSelectionModeOpen)

End Sub

我认为CATIA.FileSelectionBox()在CATScript中工作正常,所以我在考虑使用Application.ExecuteScript()运行CATScript。当我尝试这样做时会弹出另一个错误"标记为受限制的功能或界面......"。任何人都可以给我一个替代方法吗?非常感谢。

1 个答案:

答案 0 :(得分:0)

好的,我找到了答案。谢谢你让我在这里发布我的问题。接下来,我发布一个工作得很好的代码。唯一不完整的是我无法在此代码中为* .CATParts或* .CATProducts等文件类型添加过滤器。但它已经适合我。

Function SelectFile( )
' File Browser via HTA
' Author:   Rudi Degrande, modifications by Denis St-Pierre and Rob van der 
Woude
' Features: Works in Windows Vista and up (Should also work in XP).
'           Fairly fast.
'           All native code/controls (No 3rd party DLL/ XP DLL).
' Caveats:  Cannot define default starting folder.
'           Uses last folder used with MSHTA.EXE stored in Binary in 
[HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\ComDlg32].
'           Dialog title says "Choose file to upload".
' Source:   https://social.technet.microsoft.com/Forums/scriptcenter/en-
US/a3b358e8-15ae-4ba3-bca5-ec349df65ef6/windows7-vbscript-open-file-dialog-
box-fakepath?forum=ITCG

Dim objExec, strMSHTA, wshShell

SelectFile = ""

' For use in HTAs as well as "plain" VBScript:
strMSHTA = "mshta.exe ""about:" & "<" & "input type=file id=FILE>" _
         & "<" & "script>FILE.click();new 
ActiveXObject('Scripting.FileSystemObject')" _
         & 
".GetStandardStream(1).WriteLine(FILE.value);close();resizeTo(0,0);" & "<" & 
"/script>"""
' For use in "plain" VBScript only:
' strMSHTA = "mshta.exe ""about:<input type=file id=FILE>" _
'          & "<script>FILE.click();new 
ActiveXObject('Scripting.FileSystemObject')" _
'          & 
".GetStandardStream(1).WriteLine(FILE.value);close();resizeTo(0,0);
</script>"""

Set wshShell = CreateObject( "WScript.Shell" )
Set objExec = wshShell.Exec( strMSHTA )

SelectFile = objExec.StdOut.ReadLine( )

Set objExec = Nothing
Set wshShell = Nothing
End Function

亲切的问候