Find File Button 1

[JaneB19]

Hi

I'm having some problems with this! What I'm trying to do is allow the user to select an Excel file to upload into an Access database. At the moment I've got the upload working for a specified file (to check that the upload worked! ) but I'd like to make it so that this file can be changed.

I'm only a temp so once it's working I won't be around to change the file for them or show them how to alter the coding!!!!! Not a good idea anyway!

I have the following code, but it doesn't work and I know that there's a bit, or a lot, missing and I can't think how it should be done!

Private Sub ScorecardList_BeforeUpdate(Cancel As Integer)
Dim ScorecardPath, cardList

ScorecardPath = Dir("C:\Documents and Settings\bradlejx\My Documents\ScoreCards\Trial\*.html&quot

Do While cardList <= EOF
GetAttr (ScorecardPath)

cardList = Dir
Loop

End Sub

It's mainly the Do While Loop that I'm having problems with, as I think that I've done the Path correctly.

Please correct me if I'm wrong. We learn from our mistakes and I make a lot of mistakes unfortunately as I'm only a beginner at VBA!

Thanks
Jane

[PC2]

 

[VBOnly]

Most code are right except that Dir() returns a string. So in Do While, just check if it is empty (Do While cardList <> &quot;&quot. It is also to check your first return from Dir() call, or use the same variable for all Dir() returns.

 

[JaneB19]

Hi Jrao

Thanks for your reply.

Would you, or anybody else, by any chance know any other reasons why, after making the amendments you suggested in your reply, there would still be no files displayed?

Cheers

Jane

[PC2]

 

[VBOnly]

You may have the directory misspelled. Try Dir(&quot;...\*.*), you should at least get &quot;.&quot; and &quot;..&quot; directories if the directory exists.
The files could be *.htm, then use &quot;C:....*.htm*.
An argument could be added to the Dir as: Dir(&quot;C:\Documents and Settings\bradlejx\My Documents\ScoreCards\Trial\*.html&quot;, vbNormal). vbNormal is by default, it should not help.

 

[JaneB19]

Hi me again!

I've been away trying your possible solutions and several variations too. Unfortunately I still can't get anything to show in the comboBox.

Is there anything else I could do, or even another way I could go about showing the available files to the user?

Thanks

Jane

[PC2]

 

[VBOnly]

Try to display all file and dirs of a known directory and debug.print them.

Or, I think the problem may be that this routine is never called. Change it to the double click event or put it in Form inialization method, or the event code of a button.

<CODE>
Private Sub ScorecardList_dblClick(Cancel As Integer)
Dim ScorecardPath as string, cardList as string

ScorecardPath = Dir(&quot;C:\*.*&quot
ScorecardList.Clear
Do While cardList <= EOF
IF GetAttr (ScorecardPath) & vbNormal then
ScorecardList.AddItem, cardList
debug.print cardList
End If
cardList = Dir
Loop
End Sub
</CODE>

 

[RamziSaab]

Jane this will do exactly what you want, it will open a browse form (liek the one when u press open or save etc.)

Make a module and copy and paste the following:

************************************************************

Option Explicit
Option Compare Database
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' This Module contains commonly used file functions:
' GetDirectory - API wrapper for SHBrowseForFolder Function
' FindFile - ask the user to pick a specific file
' FindDB - Specific FindFile for Access MDBs
' RefreshLinks - refresh linked tables in a database
'
' All code has been lifted & adapted from Microsoft Sources
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

'API Functions
Private Declare Function GetOpenFileName Lib &quot;comdlg32.dll&quot; Alias _
&quot;GetOpenFileNameA&quot; (pOpenfilename As OPENFILENAME) As Boolean
Private Declare Function GetSaveFileName Lib &quot;comdlg32.dll&quot; Alias _
&quot;GetSaveFileNameA&quot; (pOpenfilename As OPENFILENAME) As Boolean
Private Declare Function SHBrowseForFolder Lib &quot;shell32&quot; _
(lpbi As BrowseInfo) As Long

Private Declare Function SHGetPathFromIDList Lib &quot;shell32&quot; _
(ByVal pidList As Long, _
ByVal lpBuffer As String) As Long

Private Declare Function lstrcat Lib &quot;kernel32&quot; Alias &quot;lstrcatA&quot; _
(ByVal lpString1 As String, ByVal _
lpString2 As String) As Long

'constants
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260
Private Const ALLFILES = &quot;All Files&quot;
Private Const OFN_ALLOWMULTISELECT = &H200
Private Const OFN_CREATEPROMPT = &H2000
Private Const OFN_EXPLORER = &H80000
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_NOCHANGEDIR = &H8
Private Const OFN_NODEREFERENCELINKS = &H100000
Private Const OFN_NONETWORKBUTTON = &H20000
Private Const OFN_NOREADONLYRETURN = &H8000
Private Const OFN_NOVALIDATE = &H100
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_READONLY = &H1
Private Const OFN_SHOWHELP = &H10

'types
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type

Private Type MSA_OPENFILENAME
' Filter string used for the Open dialog filters.
' Use MSA_CreateFilterString() to create this.
' Default = All Files, *.*
strFilter As String
' Initial Filter to display.
' Default = 1.
lngFilterIndex As Long
' Initial directory for the dialog to open in.
' Default = Current working directory.
strInitialDir As String
' Initial file name to populate the dialog with.
' Default = &quot;&quot;.
strInitialFile As String
strDialogTitle As String
' Default extension to append to file if user didn't specify one.
' Default = System Values (Open File, Save File).
strDefaultExtension As String
' Flags (see constant list) to be used.
' Default = no flags.
lngFlags As Long
' Full path of file picked. When the File Open dialog box is
' presented, if the user picks a nonexistent file,
' only the text in the &quot;File Name&quot; box is returned.
strFullPathReturned As String
' File name of file picked.
strFileNameReturned As String
' Offset in full path (strFullPathReturned) where the file name
' (strFileNameReturned) begins.
intFileOffset As Integer
' Offset in full path (strFullPathReturned) where the file extension begins.
intFileExtension As Integer
End Type

Private 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


'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Function RefreshLinks
' Inputs: strFileName - FileName of Database
' Outputs:Return True if successful.
' Comments: Refresh links to the supplied database.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Public Function RefreshLinks(strFileName As String) As Boolean
Dim dbs As Database
Dim tdf As TableDef

' Loop through all tables in the database.
Set dbs = CurrentDb
For Each tdf In dbs.TableDefs
' If the table has a connect string, it's a linked table.
If Len(tdf.Connect) > 0 Then
tdf.Connect = &quot;;DATABASE=&quot; & strFileName
Err = 0
On Error Resume Next
tdf.RefreshLink ' Relink the table.
If Err <> 0 Then
RefreshLinks = False
Exit Function
End If
End If
Next tdf
RefreshLinks = True ' Relinking complete.
End Function


'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Function GetDirectory
' Inputs: szTitle - Text Prompt in Dialog Box
' CallingForm - Form that is to act as owner of dialog (usually Me)
' Outputs:Returns Selected Directory Path
' Comments: Opens a Treeview control that displays the directories in a computer
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Public Function GetDirectory(szTitle As String, CallingForm As Form) As String
Dim lpIDList As Long
Dim sBuffer As String
Dim tBrowseInfo As BrowseInfo

With tBrowseInfo
.hWndOwner = CallingForm.hwnd
.lpszTitle = lstrcat(szTitle, &quot;&quot
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With

lpIDList = SHBrowseForFolder(tBrowseInfo)

If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
GetDirectory = sBuffer
End If
End Function


'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Function FindDB
' Inputs: strSearchPath - Initial Path to set dialog to
' Outputs:Returns the full path to Database.
' Comments: Displays the Open dialog box for the user to locate
' a database.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Public Function FindDB(SearchPath) As String
Dim msaof As MSA_OPENFILENAME

' Set options for the dialog box.
msaof.strDialogTitle = &quot;Where Is The Database?&quot;
If IsNull(SearchPath) Then SearchPath = &quot;c:\&quot;
msaof.strInitialDir = SearchPath
msaof.strFilter = MSA_CreateFilterString(&quot;Databases&quot;, &quot;*.mdb&quot

' Call the Open dialog routine.
MSA_GetOpenFileName msaof

' Return the path and file name.
FindDB = Trim(msaof.strFullPathReturned)

End Function


'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Function FindFile
' Inputs: SearchPath - Initial Path to set dialog to
' Title - Title of the dialog box
' Filtername - frendly name for type of files to be located (E.G. &quot;Excel Files&quot
' Filter - Wildcard Patern for Files (E.G. *.XLS)
' Outputs:Returns the full path to File.
' Comments: Displays the Open dialog box for the user to locate
' a File.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Public Function FindFile(SearchPath As String, Title As String, FilterName As String, Filter As String) As String
Dim msaof As MSA_OPENFILENAME

' Set options for the dialog box.
msaof.strDialogTitle = Title
msaof.strInitialDir = SearchPath
msaof.strFilter = MSA_CreateFilterString(FilterName, Filter)

' Call the Open dialog routine.
MSA_GetOpenFileName msaof

' Return the path and file name.
FindFile = Trim(msaof.strFullPathReturned)

End Function


Private Function MSA_CreateFilterString(ParamArray varFilt() As Variant) As String
' Creates a filter string from the passed in arguments.
' Returns &quot;&quot; if no argumentss are passed in.
' Expects an even number of argumentss (filter name, extension), but
' if an odd number is passed in, it appends &quot;*.*&quot;.

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

Private Function MSA_ConvertFilterString(strFilterIn As String) As String
' Creates a filter string from a bar (&quot;|&quot separated string.
' The string should pairs of filter|extension strings, i.e. &quot;Access Databases|*.mdb|All Files|*.*&quot;
' If no extensions exists for the last filter pair, *.* is added.
' This code will ignore any empty strings, i.e. &quot;||&quot; pairs.
' Returns &quot;&quot; if the strings passed in is empty.


Dim strFilter As String
Dim intNum As Integer, intPos As Integer, intLastPos As Integer

strFilter = &quot;&quot;
intNum = 0
intPos = 1
intLastPos = 1

' Add strings as long as we find bars.
' Ignore any empty strings (not allowed).
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)

' Get last string if it exists (assuming strFilterIn was not bar terminated).
intPos = Len(strFilterIn)
If (intPos >= intLastPos) Then
strFilter = strFilter & Mid(strFilterIn, intLastPos, intPos - intLastPos + 1) & vbNullChar
intNum = intNum + 1
End If

' Add *.* if there's no extension for the last string.
If intNum Mod 2 = 1 Then
strFilter = strFilter & &quot;*.*&quot; & vbNullChar
End If

' Add terminating NULL if we have any filter.
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
' Opens the file save dialog.

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

Private Function MSA_SimpleGetSaveFileName() As String
' Opens the file save dialog with default values.

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
' Opens the Open dialog.

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 Function MSA_SimpleGetOpenFileName() As String
' Opens the Open dialog with default values.

Dim msaof As MSA_OPENFILENAME
Dim intRet As Integer
Dim strRet As String

intRet = MSA_GetOpenFileName(msaof)
If intRet Then
strRet = msaof.strFullPathReturned
End If

MSA_SimpleGetOpenFileName = strRet
End Function


Private Sub OF_to_MSAOF(of As OPENFILENAME, msaof As MSA_OPENFILENAME)
' This sub converts from the Win32 structure to the Microsoft Access structure.

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)
' This sub converts from the Microsoft Access structure to the Win32 structure.

Dim strFile As String * 512

' Initialize some parts of the structure.
of.hWndOwner = Application.hWndAccessApp
of.hInstance = 0
of.lpstrCustomFilter = 0
of.nMaxCustrFilter = 0
of.lpfnHook = 0
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

***********************************************************


now in order or you to call these functions make a command button in a form and paste

*********************************************************
strExcelFile = FindFile(&quot;PATH OF FOLDER&quot;, &quot;Please Select an Excel File&quot;, &quot;Excel Files&quot;, &quot;*.xl?&quot

**********************************************************


now the strExcelFile will have the path of what the user selected.

Hope this helps and you understand

Ramzi

 

[RamziSaab]

btw in the form where u have to put the

PATH OF THE Folder e.g.

strExcelFile = FindFile(&quot;C:\Temp&quot;, &quot;Please Select an Excel File&quot;, &quot;Excel Files&quot;, &quot;*.xl?&quot

 

[steff]

Hello

I have several question from strExcelFile = FindFile(&quot;C:\Temp&quot;, &quot;Please Select an Excel File&quot;, &quot;Excel Files&quot;, &quot;*.xl?&quot

First, can I apply this to picture files ?
Second, can I put the selected file to a specified directory?
Third, can I put the file name into an access field ?
Fourth,if I have a picture file name in my access field, can I see the picture in my access formulary ?

Thanks
Cordially
Steff

http://www.c-comnet.com

 

[RamziSaab]

Hey, i can answer most of your questions:

1. Yes you can, just change the path to something like below, if they are onlyt jpegs you can chagne the *.* to 8.jpg etc:
strExcelFile = FindFile(&quot;C:\Temp&quot;, &quot;Please Select an a picture&quot;, &quot;Picture Files&quot;, &quot;*.*&quot

2.You can tell it where to look by telling it the path
strExcelFile = FindFile(&quot;C:\my path here\at this folder&quot;, &quot;Please Select an a picture&quot;, &quot;Picture Files&quot;, &quot;*.*&quot

3. the file address will be saved in teh string strexcelfile (or whatever u name it) so u can put it into a field text box etc...

4.dont know