File Selection Box

[eveCalypso]

Hello All,

I need the user to select a document using a file box such as the one you get when doing a Insert --> File command - a file box which has a "Range..." object.

I recorded a macro doing this, but I can only get it working if I give the exact filename up front.
I need the command to either:
a) See its returning many files of that type and open a command box/list/whatever to let the user choose, or
b) I need to be able to open this dialog up front in the correct area.

The recorded macro yielded:
ChangeFileOpenDirectory "C:\test\Motion Test\"
Selection.InsertFile FileName:="COS00003.doc", Range:="Motion", ConfirmConversions:=False, Link:=False, Attachment:=False

Ideally I would somehow want to make this work:
ChangeFileOpenDirectory "C:\test\Motion Test\"
Dim aFile As String
aFile = "*COS00003*.doc"
Selection.InsertFile FileName:=aFile, Range:="Motion", _
ConfirmConversions:=True, Link:=False, Attachment:=False

where it will then prompt me with a subset of files I can choose.

ANY help would be appreciated!
Rgds,
EvE

 

[RiazKhanmohamed]

i had this problem, and found a link from around here to do it. however, i can't remember what that link was. but i still used the code. so i'll attach it below. don't need any extra references as far as i'm aware.

create a new module, and paste in this code - probably worth calling it modCommonDialog:

'*****************************************************

Option Compare Database
Option Explicit

Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias _
"GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Boolean

Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As Long) As Long

Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long

Type MSA_OPENFILENAME
strFilter As String
lngFilterIndex As Long
strInitialDir As String
strInitialFile As String
strDialogTitle As String
strDefaultExtension As String
lngFlags As Long
strFullPathReturned As String
strFileNameReturned As String
intFileOffset As Integer
intFileExtension As Integer
End Type

Const ALLFILES = "All Files"

Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As Long
nMaxCustrFilter 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
lCustrData As Long
lpfnHook As Long
lpTemplateName As Long
End Type

Const OFN_ALLOWMULTISELECT = &H200
Const OFN_CREATEPROMPT = &H2000
Const OFN_EXPLORER = &H80000
Const OFN_FILEMUSTEXIST = &H1000
Const OFN_HIDEREADONLY = &H4
Const OFN_NOCHANGEDIR = &H8
Const OFN_NODEREFERENCELINKS = &H100000
Const OFN_NONETWORKBUTTON = &H20000
Const OFN_NOREADONLYRETURN = &H8000
Const OFN_NOVALIDATE = &H100
Const OFN_OVERWRITEPROMPT = &H2
Const OFN_PATHMUSTEXIST = &H800
Const OFN_READONLY = &H1
Const OFN_SHOWHELP = &H10

Global glFileName As String
Global glPath As String
Global glInitDir As String


Function MSA_CreateFilterString(ParamArray varFilt() As Variant) As String
Dim strFilter As String
Dim intRet As Integer
Dim intNum As Integer
intNum = UBound(varFilt)
If (intNum <> -1) Then
For intRet = 0 To intNum
strFilter = strFilter & varFilt(intRet) & vbNullChar
Next
If intNum Mod 2 = 0 Then
strFilter = strFilter & &quot;*.*&quot; & vbNullChar
End If
strFilter = strFilter & vbNullChar
Else
strFilter = &quot;&quot;
End If
MSA_CreateFilterString = strFilter
End Function

Function MSA_ConvertFilterString(strFilterIn As String) As String
Dim strFilter As String
Dim intNum As Integer, intPos As Integer, intLastPos As Integer
strFilter = &quot;&quot;
intNum = 0
intPos = 1
intLastPos = 1
Do
intPos = InStr(intLastPos, strFilterIn, &quot;|&quot
If (intPos > intLastPos) Then
strFilter = strFilter & Mid(strFilterIn, intLastPos, intPos - intLastPos) & vbNullChar
intNum = intNum + 1
intLastPos = intPos + 1
ElseIf (intPos = intLastPos) Then
intLastPos = intPos + 1
End If
Loop Until (intPos = 0)
intPos = Len(strFilterIn)
If (intPos >= intLastPos) Then
strFilter = strFilter & Mid(strFilterIn, intLastPos, intPos - intLastPos + 1) & vbNullChar
intNum = intNum + 1
End If
If intNum Mod 2 = 1 Then
strFilter = strFilter & &quot;*.*&quot; & vbNullChar
End If
If strFilter <> &quot;&quot; Then
strFilter = strFilter & vbNullChar
End If
MSA_ConvertFilterString = strFilter
End Function

Private Function MSA_GetSaveFileName(msaof As MSA_OPENFILENAME) As Integer
Dim of As OPENFILENAME
Dim intRet As Integer
MSAOF_tF msaof, of
of.flags = of.flags Or OFN_HIDEREADONLY
intRet = GetSaveFileName(of)
If intRet Then
OF_to_MSAOF of, msaof
End If
MSA_GetSaveFileName = intRet
End Function

Function MSA_SimpleGetSaveFileName() As String
Dim msaof As MSA_OPENFILENAME
Dim intRet As Integer
Dim strRet As String
intRet = MSA_GetSaveFileName(msaof)
If intRet Then
strRet = msaof.strFullPathReturned
End If
MSA_SimpleGetSaveFileName = strRet
End Function

Private Function MSA_GetOpenFileName(msaof As MSA_OPENFILENAME) As Integer
Dim of As OPENFILENAME
Dim intRet As Integer
MSAOF_tF msaof, of
intRet = GetOpenFileName(of)
If intRet Then
OF_to_MSAOF of, msaof
End If
MSA_GetOpenFileName = intRet
End Function

Private Sub OF_to_MSAOF(of As OPENFILENAME, msaof As MSA_OPENFILENAME)
msaof.strFullPathReturned = Left(of.lpstrFile, InStr(of.lpstrFile, vbNullChar) - 1)
msaof.strFileNameReturned = of.lpstrFileTitle
msaof.intFileOffset = of.nFileOffset
msaof.intFileExtension = of.nFileExtension
End Sub

Private Sub MSAOF_tF(msaof As MSA_OPENFILENAME, of As OPENFILENAME)
Dim strFile As String * 512
of.hwndOwner = Application.hWndAccessApp
of.hInstance = 0
of.lpstrCustomFilter = 0
of.nMaxCustrFilter = 0
of.lpfnHook = 1
of.lpTemplateName = 0
of.lCustrData = 0
If msaof.strFilter = &quot;&quot; Then
of.lpstrFilter = MSA_CreateFilterString(ALLFILES)
Else
of.lpstrFilter = msaof.strFilter
End If
of.nFilterIndex = msaof.lngFilterIndex
of.lpstrFile = msaof.strInitialFile _
& String(512 - Len(msaof.strInitialFile), 0)
of.nMaxFile = 511
of.lpstrFileTitle = String(512, 0)
of.nMaxFileTitle = 511
of.lpstrTitle = msaof.strDialogTitle
of.lpstrInitialDir = msaof.strInitialDir
of.lpstrDefExt = msaof.strDefaultExtension
of.flags = msaof.lngFlags
of.lStructSize = Len(of)
End Sub

Function Find_File(strSearchPath) As String
Dim msaof As MSA_OPENFILENAME
msaof.strDialogTitle = &quot;Select A File&quot;
msaof.strInitialDir = strSearchPath
msaof.strFilter = MSA_CreateFilterString _
(&quot;All Files (*.*)&quot;, &quot;*.*&quot;, _
&quot;Access Databases (*.mdb;*.mde;*.adp;*.ade)&quot;, &quot;*.mdb;*.mde;*.adp;*.ade&quot;, _
&quot;Excel Files (*.xl*)&quot;, &quot;*.xl*&quot;, _
&quot;Text Files (*.txt)&quot;, &quot;*.txt&quot;, _
&quot;Word Documents (*.doc;*.rtf)&quot;, &quot;*.doc;*.rtf&quot
MSA_GetOpenFileName msaof
Find_File = Trim(msaof.strFullPathReturned)
End Function

Public Function GetFileInformation(strPathAndFileName As String)
Dim i As Integer, j As Integer
Dim intCurrPos As Integer
Dim intNextPos As Integer
Dim intFinalPos As Integer
Dim intLength As Integer
intCurrPos = 1
intLength = Len(strPathAndFileName)
For i = 1 To intLength Step intCurrPos
intNextPos = InStr(intCurrPos + 1, strPathAndFileName, &quot;\&quot
If intNextPos = 0 Then
glFileName = Mid(strPathAndFileName, intCurrPos + 1, intLength)
intFinalPos = intCurrPos
End If
intCurrPos = intNextPos
Next i
glPath = Mid(strPathAndFileName, 1, intFinalPos - 1)
glInitDir = glPath
End Function

'*****************************************************

Then have a button on your form or wherever with this code:

Me.#output field name# = Find_File(glInitDir)

Hope this helps. i'll try and find the link.

 

[eveCalypso]

Wow

Thank you for that. I will try it straight away and let you know if it does what I need it to do!

Best Regards,
EvE

 

[eveCalypso]

Mr Perry,

No that is not exactly what I am looking for.
If you open a Word document and go to Insert--> File...
on the file menu, you will see that that specific dialog has a &quot;Range...&quot; object to the left of the &quot;Insert&quot; Button.
I need a dialog of this kind!

If you have any more suggestions, I would be eternally grateful ;-)

Regards,
EvE

 

[RiazKhanmohamed]

oops. sorry. can't help you there.

this is where i found the information - there may be something useful here for you:

http://www.tek-tips.com/gthreadminder.cfm/lev2/4/lev3/27/pid/705

 

[eveCalypso]

Mr Perry,

That is ok. Thank you for trying anyway!
I could of course ask for the file in the way you suggested and then just run that file through what I have. That might in fact work!

Amazing how such things can completely ruin your day!! I will let you know if what I just suggested works... in theory it should.

Thanks again!
EvE

 

[eveCalypso]

Wheyhey!!!
*Bounce* *Bounce*

That works 100%. I am happy with that.

Regards,
EvE