1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115
| Option Compare Text
Option Explicit
Private Declare Function ap_GetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Const cdlOFNAllowMultiselect = &H200
Const cdlOFNCreatePrompt = &H2000
Const cdlOFNExplorer = &H80000
Const cdlOFNExtensionDifferent = &H400
Const cdlOFNFileMustExist = &H1000
Const cdlOFNHelpButton = &H10
Const cdlOFNHideReadOnly = &H4
Const cdlOFNLongNames = &H200000
Const cdlOFNNoChangeDir = &H8
Const CdlOFNNoDereferenceLinks = &H100000
Const cdlOFNNoLongNames = &H40000
Const CdlOFNNoReadOnlyReturn = &H8000
Const cdlOFNNoValidate = &H100
Const cdlOFNOverwritePrompt = &H2
Const cdlOFNPathMustExist = &H800
Const cdlOFNReadOnly = &H1
Const CdlOFNShareAware = &H4000
Public Function ap_OpenFile(Optional ByVal strFileNameIn _
As String = "", Optional strDialogTitle _
As String = "Choisir un fichier")
Dim lngReturn As Long
Dim intLocNull As Integer
Dim strTemp As String
Dim ofnFileInfo As OPENFILENAME
Dim strInitialDir As String
Dim strFileName As String
'-- if a file path passed in with the name,
'-- parse it and split it off.
If InStr(strFileNameIn, "\") <> 0 Then
strInitialDir = Left(strFileNameIn, InStrRev(strFileNameIn, "\"))
strFileName = Left(Mid$(strFileNameIn, _
InStrRev(strFileNameIn, "\") + 1) & _
String(256, 0), 256)
Else
strInitialDir = Left(CurrentDb.Name, _
InStrRev(CurrentDb.Name, "\") - 1)
strFileName = Left(strFileNameIn & String(256, 0), 256)
End If
With ofnFileInfo
.lStructSize = Len(ofnFileInfo)
.lpstrFile = strFileName
.lpstrFileTitle = String(256, 0)
.lpstrInitialDir = strInitialDir
.hwndOwner = Application.hWndAccessApp
.lpstrFilter = "All Files (*.*)" & Chr(0) & "*.*" & Chr(0)
.nFilterIndex = 1
.nMaxFile = Len(strFileName)
.nMaxFileTitle = ofnFileInfo.nMaxFile
.lpstrTitle = strDialogTitle
.flags = cdlOFNFileMustExist Or cdlOFNHideReadOnly Or _
cdlOFNNoChangeDir
.hInstance = 0
.lpstrCustomFilter = String(255, 0)
.nMaxCustFilter = 255
.lpfnHook = 0
End With
lngReturn = ap_GetOpenFileName(ofnFileInfo)
If lngReturn = 0 Then
strTemp = ""
Else
'-- Trim off any null string
strTemp = Trim(ofnFileInfo.lpstrFile)
intLocNull = InStr(strTemp, Chr(0))
If intLocNull Then
strTemp = Left(strTemp, intLocNull - 1)
End If
End If
ap_OpenFile = strTemp
End Function |
Partager