进行文件操作时,经常要用 VBA 选择目标文件夹,可以试用下面几种实现代码:1.FileDialog 属性 Sub Sample1() With Application.FileDialog(msoFileDialogFolderPicker) If .Show = True Then MsgBox .SelectedItems(1) End If End With End Sub2.shell 方法 Sub Sample2() Dim Shell, myPath Set Shell = CreateObject("Shell.Application") Set myPath = Shell.BrowseForFolder(&O0, "请选择文件夹", &H1 + &H10, "G:\") If Not myPath Is Nothing Then MsgBox myPath.Items.Item.Path Set Shell = Nothing Set myPath = Nothing End Sub3.API 方法 Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _ (ByVal pidl As Long, ByVal pszPath As String) As Long Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _ (lpBrowseInfo As BROWSEINFO) As Long Declare Function GetDesktopWindow Lib "user32" () As LongPublic Type BROWSEINFO hOwner As Long pidlRoot As Long pszDisplayName As String lpszTitle As String ulFlags As Long lpfn As Long lParam As Long iImage As Long End Type Sub Sample3() Dim buf As String buf = GetFolder("请选择文件夹") If buf = "" Then Exit Sub MsgBox buf End Sub Function GetFolder(Optional Msg) As String Dim bInfo As BROWSEINFO, pPath As String Dim R As Long, X As Long, pos As Integer bInfo.pidlRoot = 0& bInfo.lpszTitle = Msg bInfo.ulFlags = &H1 X = SHBrowseForFolder(bInfo) pPath = Space$(512) R = SHGetPathFromIDList(ByVal X, ByVal pPath) If R Then pos = InStr(pPath, Chr$(0)) GetFolder = Left(pPath, pos - 1) Else GetFolder = "" End If End Function
3L的看不懂 不过还是谢谢你 var fileName = ""; function getFilePath(){ var fileDialog =document.getElementById("fileDialog"); fileDialog.CancelError=true; try{ fileDialog.Filter="Image Files (*.gif)|ALL Files (*.*)|*.*"; fileDialog.ShowSave(); alert("印章文件将被导入"+fileDialog.filename); }catch(e){
Sub Sample1()
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
MsgBox .SelectedItems(1)
End If
End With
End Sub2.shell 方法
Sub Sample2()
Dim Shell, myPath
Set Shell = CreateObject("Shell.Application")
Set myPath = Shell.BrowseForFolder(&O0, "请选择文件夹", &H1 + &H10, "G:\")
If Not myPath Is Nothing Then MsgBox myPath.Items.Item.Path
Set Shell = Nothing
Set myPath = Nothing
End Sub3.API 方法
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As Long
Declare Function GetDesktopWindow Lib "user32" () As LongPublic Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Sub Sample3()
Dim buf As String
buf = GetFolder("请选择文件夹")
If buf = "" Then Exit Sub
MsgBox buf
End Sub
Function GetFolder(Optional Msg) As String
Dim bInfo As BROWSEINFO, pPath As String
Dim R As Long, X As Long, pos As Integer
bInfo.pidlRoot = 0&
bInfo.lpszTitle = Msg
bInfo.ulFlags = &H1
X = SHBrowseForFolder(bInfo)
pPath = Space$(512)
R = SHGetPathFromIDList(ByVal X, ByVal pPath)
If R Then
pos = InStr(pPath, Chr$(0))
GetFolder = Left(pPath, pos - 1)
Else
GetFolder = ""
End If
End Function
var fileName = "";
function getFilePath(){
var fileDialog =document.getElementById("fileDialog");
fileDialog.CancelError=true;
try{
fileDialog.Filter="Image Files (*.gif)|ALL Files (*.*)|*.*";
fileDialog.ShowSave();
alert("印章文件将被导入"+fileDialog.filename);
}catch(e){
}
}
function exportSeal(){
if(fileName==""){
alert("请选择要导出的文件");
return;
}
}
这个是公司原来的人留下的看不懂什么意思? 扔个我了 还在学习中 继续等待高手解答