[密技]：ActiveX BrowseForFolder 秘技

mmmm

使用Shell.Application的BrowseForFolder方法可以打开浏览文件夹对话。在Windows中，这种对话有两种界面：含有选定文本框的和没有文本框的。在调用中区别这两种界面的方法可以通过控制BrowseForFolder方法的第三个变量来实现。

; 1 RestrictToFilesystem = &H1 ' BIF_RETURNONLYFSDIRS
; 2 RestrictToDomain = &H2 ' BIF_DONTGOBELOWDOMAIN
; 8 RestrictToSubfolders = &H8 ' BIF_RETURNFSANCESTORS
; 16 ShowTextBox = &H10 ' BIF_EDITBOX  含有选定的文本框
; 32 ValidateSelection = &H20 ' BIF_VALIDATE
; 64 NewDialogStyle = &H40 ' BIF_NEWDIALOGSTYLE 新型的对话类型
; 4096 BrowseForComputer = &H1000 ' BIF_BROWSEFORCOMPUTER  浏览计算机
; 8192 BrowseForPrinter = &H2000 ' BIF_BROWSEFORPRINTER 浏览打印机
; 16384 BrowseForEverything = &H4000 ' BIF_BROWSEINCLUDEFILES 包括桌面上的快捷方式，但是返回值不是路径

上面这些数值可以单独或逻辑相加来控制BrowseForFolder方法

由于在浏览文件夹时，我们可能选中一些没有实际地址的文件夹，如：网上邻居、我的电脑等，BrowseForFolder方法在这种情况下回返回一个含有GUID的字符串如"::{4662DAAD-D393-11D0-9A56-00C04FB68BF7}"。在程序中，我们需要将其转换成真正选中的位置名称（不是文件夹）。

示例的代码可以打开含有选定文本框的界面并正确返回选定的文件夹或位置名称。

2. 
   
3. ;|  Perform Windows browse folder dialog interface
   
4. Syntax: (vldos-browsedir PromptString[STRING])
   
5.         (vldos-writefile NIL)
   
6.   ARG1: The prompt string, if it is nil, use default prompt string of "Select Folder"
   
7. Description:
   
8.     Display windows browse folder interface sna let user select a folder
   
9. Return Value:
   
10. [Success]: The selected folder path. If user pick cancel, return NIL
    
11. [F a i l]: NIL
    
12. |;
    
13. (Defun vldos-browsedir (msg / WinShell shFolder path catchit rtn)
    
14.   (if (null MSG)
    
15.     (setq MSG "Select folder")
    
16.   )
    
17.   (if (and (setq winshell (vlax-create-object "Shell.Application"))
    
18.            (setq shFolder
    
19.                   (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 48)
    
20.            )
    
21.       )
    
22.     (progn
    
23.       (setq catchit
    
24.              (vl-catch-all-apply
    
25.                '(lambda        ()
    
26.                   (setq shFolder (vlax-get-property shFolder 'self))
    
27.                   (setq path (vlax-get-property shFolder 'path))
    
28.                 )
    
29.              )
    
30.       )
    
31.       (vlax-release-object shFolder)
    
32.       (vlax-release-object winshell)
    
33.       (if (vl-catch-all-error-p catchit)
    
34.         (setq rtn nil)
    
35.         (progn
    
36.           (setq rtn path)
    
37.           (cond        ((and (= (substr rtn 1 3) "::{")
    
38.                       (= (substr rtn (strlen rtn)) "}")
    
39.                  )
    
40.                  (setq
    
41.                    rtn (vl-registry-read
    
42.                          (strcat "HKEY_CLASSES_ROOT\\CLSID\"
    
43.                                  (substr rtn 3)
    
44.                          )
    
45.                        )
    
46.                  )
    
47.                 )
    
48.                 ((and (= (substr rtn 1 1) "\")
    
49.                       (/= (substr rtn 1 2) "\\\")
    
50.                  )
    
51.                  (setq rtn (strcat "\" rtn))
    
52.                 )
    
53.           )
    
54.         )
    
55.       )
    
56.     )
    
57.   )
    
58.   rtn
    
59. )
    

<br /> ;|  Perform Windows browse folder dialog interface<br /> Syntax: (vldos-browsedir PromptString[STRING])<br />         (vldos-writefile NIL)<br />   ARG1: The prompt string, if it is nil, use default prompt string of "Select Folder"<br /> Description:<br />     Display windows browse folder interface sna let user select a folder<br /> Return Value:<br /> [Success]: The selected folder path. If user pick cancel, return NIL<br /> [F a i l]: NIL<br /> |;<br /> (Defun vldos-browsedir (msg / WinShell shFolder path catchit rtn)<br />   (if (null MSG)<br />     (setq MSG "Select folder")<br />   )<br />   (if (and (setq winshell (vlax-create-object "Shell.Application"))<br />            (setq shFolder<br />                   (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 48)<br />            )<br />       )<br />     (progn<br />       (setq catchit<br />              (vl-catch-all-apply<br />                '(lambda        ()<br />                   (setq shFolder (vlax-get-property shFolder 'self))<br />                   (setq path (vlax-get-property shFolder 'path))<br />                 )<br />              )<br />       )<br />       (vlax-release-object shFolder)<br />       (vlax-release-object winshell)<br />       (if (vl-catch-all-error-p catchit)<br />         (setq rtn nil)<br />         (progn<br />           (setq rtn path)<br />           (cond        ((and (= (substr rtn 1 3) "::{")<br />                       (= (substr rtn (strlen rtn)) "}")<br />                  )<br />                  (setq<br />                    rtn (vl-registry-read<br />                          (strcat "HKEY_CLASSES_ROOT\\CLSID\"<br />                                  (substr rtn 3)<br />                          )<br />                        )<br />                  )<br />                 )<br />                 ((and (= (substr rtn 1 1) "\")<br />                       (/= (substr rtn 1 2) "\\\")<br />                  )<br />                  (setq rtn (strcat "\" rtn))<br />                 )<br />           )<br />         )<br />       )<br />     )<br />   )<br />   rtn<br /> )<br />

JOSDENNIS

; error: no function definition: VLDOS-FORMATPATH

運行發現 VLDOS-FORMATPATH 涵數沒有定義.不知這個涵數主要實現什麼?

梦断江南

少一个vldos-formatpath函数，需补上

mmmm

vldos-formatpath没有什么大作用，主要是将路径的/改成\\
在这个函数中可不用

aeo

以前秋枫贴过

我就是不明白，为什么指定了起始目录，要去它的上级就不行，为什么?!

mmmm

According with the last (4th) argument for BrowseForFolder method, it is a string shows the RootFolder. So when you indicate the start location for BrowseForFolder, the RootFolder will be the placed on the top. By indicating the 4th argument, you have told the program to select folder within the RootFolder,  so you can not go outside the RootFolder to select folders.

sh_h

非常棒！！！