Bonjour,
Dans son message, < Montana DOJ Help Desk > écrivait :
In this message said:
Word 2000
I have the following code.
If Err.Number = 52 Then
With Dialogs(wdDialogFileOpen)
.Name = "Error.log"
.Display
End With
End if
Error 52 is a bad file name or file number. This is part of an error
handling routine. Basically, if the path to the error log does not exist,
then the user is given the opportunity to specify the path to the error log.
The problem is that if the folder selected by the user is empty, the Open
button in the dialog box will not work. Is there a way around this?
Try this instead:
'_______________________________________
Sub SelectFolder()
'Needs a reference to (Tools > Reference)
'Microsoft Shell Controls And Automation
'Simple version
Dim oShell As Shell32.Shell
Dim oFolder As Shell32.Folder
Dim EverythingOK As Boolean
EverythingOK = False
Set oShell = New Shell32.Shell
Set oFolder = oShell.BrowseForFolder(0, "Select ", 0)
On Error GoTo NoPath
MsgBox oFolder.Self.Path
EverythingOK = True
NoPath:
Set oFolder = Nothing
Set oShell = Nothing
If EverythingOK Then Exit Sub
On Error GoTo 0
MsgBox "Action cancelled by user.", vbExclamation, "Cancelled"
End Sub
'_______________________________________
'_______________________________________
Function GetFolderName(sCaption As String) As String
Dim oShell As Shell32.Shell
Dim oFolder As Shell32.Folder
Dim oItems As Shell32.FolderItems
Dim Item As Shell32.FolderItem
On Error GoTo CleanUp
Set oShell = New Shell ' ActiveX interface to shell32.dll
Set oFolder = oShell.BrowseForFolder(0, sCaption, 0)
Set oItems = oFolder.Items
Set Item = oItems.Item
GetFolderName = Item.Path
CleanUp:
Set oShell = Nothing
Set oFolder = Nothing
Set oItems = Nothing
Set Item = Nothing
End Function
'_______________________________________
Or:
'_______________________________________
Const BIF_RETURNONLYFSDIRS = 1
Const BIF_NEWDIALOGSTYLE = &H40
Const MAX_PATH = 260
Type BROWSEINFO
hWndOwner As Long
pidlRoot As Long
pszDisplayName As Long
lpszTitle As String
ulFlags As Long
lpfn As Long
lparam As Long
iImage As Integer
End Type
Declare Function GetActiveWindow Lib "user32" () As Long
Declare Function SHBrowseForFolder Lib "Shell32" _
(pBrInfo As BROWSEINFO) As Long
Declare Function SHGetPathFromIDList Lib "Shell32" _
(ByVal pidList As Long, _
ByVal lpBuffer As String) As Long
Declare Sub CoTaskMemFree Lib "ole32.dll" _
(ByVal pMem As Long)
Option Explicit
'sTitle = text inside browse for folder box
'_______________________________________
Public Function SelectFolder(sTitle) As String
Dim nPos As Long
Dim pidList As Long
Dim nResult As Long
Dim sPath As String
Dim pBInfo As BROWSEINFO
sPath = String(MAX_PATH, Chr(0))
sTitle = sTitle & Chr(0)
With pBInfo
'Set the owner window (current active Window)
.hWndOwner = GetActiveWindow()
.lpszTitle = sTitle
' BIF_NEWDIALOGSTYLE let the user resize the Window
' and also create new folders, delete folders and some more.
' If that is not desired, use only BIF_RETURNONLYFSDIRS
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_NEWDIALOGSTYLE
' .ulFlags = BIF_RETURNONLYFSDIRS
End With
pidList = SHBrowseForFolder(pBInfo)
If pidList <> 0 Then
SHGetPathFromIDList pidList, sPath
CoTaskMemFree pidList
nPos = InStr(sPath, Chr(0))
If nPos > 0 Then
sPath = Left(sPath, nPos - 1)
End If
End If
SelectFolder = sPath
End Function
'_______________________________________
'_______________________________________
Sub Folder_API()
Dim Mypath As String
Mypath = SelectFolder("Choose a folder")
If Replace(Mypath, Chr(0), "") = "" Then
MsgBox "No folder was chosen, or action was cancelled.", _
vbExclamation, "No folder"
Exit Sub
End If
MsgBox Mypath
End Sub
'Lars-Eric Gisslén
'_______________________________________
--
Salut!
_______________________________________
Jean-Guy Marcil - Word MVP
(e-mail address removed)
Word MVP site:
http://www.word.mvps.org