Problem with File Browse API Crashing Access Application

Hello All,

First I want to say I have been referencing this fourm for sometime now and really appreciate everyones very helpfull posts. I have been able to find the answers to many questions by searching long and hard, but finally I have something that requires me to post:


I am using the following Module to call an API to allow users to select a file to attach into an Access 2000 program I'm running.

Problem is this feature works fine if a user highlights a file and selects 'OK'. It also works good if the user selects 'Cancel'. The problem is if a user highlights a Folder instead of a file and Clicks 'OK' the whole access database crashes out completely and exits back to the PC desktop with no error message.

Is there some way I can do validation and say if this module returns a folder only not to run any further? Or allow only for file selection only.. Thanks

Module 1

Option Compare Database
Option Explicit
'This funtion is what launches the browse window
Public Const MAX_PATH = 260
Public Const BIF_BROWSEINCLUDEFILES = &H4000


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

Public Declare Sub CoTaskMemFree _
Lib "ole32.dll" _
(ByVal hMem As Long)

Public Declare Function GetDesktopWindow _
Lib "user32" () As Long

Public Declare Function lstrcat _
Lib "kernel32" _
Alias "lstrcatA" _
(ByVal lpString1 As String, _
ByVal lpString2 As String) As Long

Public Declare Function SHBrowseForFolder _
Lib "shell32" _
(lpbi As BrowseInfo) As Long

Public Declare Function SHGetPathFromIDList _
Lib "shell32" _
(ByVal pidList As Long, _
ByVal lpBuffer As String) As Long

Public Function SelectDir(strTitle As String) As String
Dim PathLen As Integer
Dim lpIDList As Long
Dim RetCode As Long
Dim DirPath As String
Dim BFFInfo As BrowseInfo

With BFFInfo
.hWndOwner = GetDesktopWindow
.lpszTitle = lstrcat(strTitle, Chr$(0))
.ulFlags = BIF_BROWSEINCLUDEFILES

End With

DirPath = ""
lpIDList = SHBrowseForFolder(BFFInfo)

If lpIDList Then
DirPath = String$(MAX_PATH, 0)
RetCode = SHGetPathFromIDList(lpIDList, DirPath)
Call CoTaskMemFree(lpIDList)
PathLen = InStr(DirPath, vbNullChar)
If PathLen Then
DirPath = Left$(DirPath, PathLen - 1)
End If
End If
SelectDir = DirPath
End Function


Module 2

Option Compare Database
'This module Parses the String path to the file attachement
Function CountCSWords(ByVal s) As Integer
'Counts the words in a string that are separated by commas.
Dim WC As Integer, Pos As Integer
If VarType(s) <> 8 Or Len(s) = 0 Then
CountCSWords = 0
Exit Function
End If
WC = 1
Pos = InStr(s, "\")
Do While Pos > 0
WC = WC + 1
Pos = InStr(Pos + 1, s, "\")
Loop
CountCSWords = WC
End Function


Module 3

Option Compare Database
'THis module returns the filename of the uploaded attachment
Function GetCSWord(ByVal s, Indx As Integer)
'Returns the nth word in a specific field.
Dim WC As Integer, Count As Integer
Dim SPos As Integer, EPos As Integer

WC = CountCSWords(s)
If Indx < 1 Or Indx > WC Then
GetCSWord = Null
Exit Function
End If
Count = 1
SPos = 1
For Count = 2 To Indx
SPos = InStr(SPos, s, "\") + 1
Next Count
EPos = InStr(SPos, s, "\") - 1
If EPos <= 0 Then EPos = Len(s)
GetCSWord = Trim(Mid(s, SPos, EPos - SPos + 1))
End Function


And here is an example of the ON_Click event i'm running on my form which displays the Browse window by callilng all of the above modules:

Private Sub cmdBrowse_Click()
'This button is the button which allows a user to include an attachment of any file type.
'It then saves this attachment to the location T:\Data Processing\PCAdmin\service2\KO # HERE\Issue\FILENAME.XXX

Dim strFolder As String
'call module 1 which pops up the file selection box
strFolder = SelectDir("c")

'This will display the source location on the form for the attachment.
txtIssueSource.SetFocus
txtIssueSource.Text = strFolder
If strFolder <> "" Then

'This function will add in the filecopy: count # of words in sourcename
Dim I As Integer
Dim intCnt As Integer
Dim strFinalDest As String

'Find out how many \ separated words are present
intCnt = CountCSWords(strFolder)

'Now call the 3rd module function to retrieve each one in turn
I = intCnt
strFinalDest = GetCSWord(strFolder, I)


'copy source file to network location
Dim DestinationFile As String
Dim strIDValue As String

strIDValue = txtID.value

'state the destination save folder for the attachment
DestinationFile = "T:\Data Processing\PCAdmin\service2\KO\" + strIDValue + "\Issue\" + strFinalDest
FileCopy strFolder, DestinationFile

'This will copy the saved location to the database
Forms!frmData!AttachmentIssue = DestinationFile
MsgBox "Attachment has been Added. To add another Attachment just repeat the process."
Else
End If
End Sub


All most positive the error lies somewhere in the On_Click event. I think my program is crashing because this On_click event is trying to save a whole folder instead of a individual file. I need some sort of validation to basically not continue the On_click event if the module returns a Folder selected only and not a individual File. Any help would be greatley Appreciated!!