paulclem
asked on
DLL Problem in Access 2.0
Within an Access 2.0 appication I have the need to allow the user to select a file using the standard file open dialogue box. This is called using:
lRet = MSAU_GetFileName(gfni, fOpen)
..where MSAU_GetFileName is contained within the DLL file MSAU200.DLL (or so I believe). This DLL was not present on the shared drive where the application is installed and thus the users got an error when trying to run this command. When I put the DLL in place it worked...for everybody except 1 user !!
Does anybody know of any reasons why 1 user out of 10 would continue to get the error cuased by the non existance of MSAU200.DLL even though it is now there ? I've tried getting them to log in / log out / reboot but to no effect.
Any ideas ?
Thanks...PaulC.
lRet = MSAU_GetFileName(gfni, fOpen)
..where MSAU_GetFileName is contained within the DLL file MSAU200.DLL (or so I believe). This DLL was not present on the shared drive where the application is installed and thus the users got an error when trying to run this command. When I put the DLL in place it worked...for everybody except 1 user !!
Does anybody know of any reasons why 1 user out of 10 would continue to get the error cuased by the non existance of MSAU200.DLL even though it is now there ? I've tried getting them to log in / log out / reboot but to no effect.
Any ideas ?
Thanks...PaulC.
Sounds strange. Is the anomolous person running a different version of access?
Thanks
Jell
Thanks
Jell
ASKER
JDettman said:
"I think if you check one of the other machines that is working, you'll find the DLL is already somewhere
else on the PC"
...To test this I actually removed MSAU200.DLL from the shared installtion directory. Having done this the file open dialog didn't appear for anybody and they all got the error message that "the 1" has been getting all along.
When I then put MSAU200.DLL back in place everybody was ok again..apart from "the 1". This proves to me that this file being in the install directory is what is needed to get the file open dialog to work...so why is this 1 person having a problem when they are all accesing the same shared drive ?
Paul C.
"I think if you check one of the other machines that is working, you'll find the DLL is already somewhere
else on the PC"
...To test this I actually removed MSAU200.DLL from the shared installtion directory. Having done this the file open dialog didn't appear for anybody and they all got the error message that "the 1" has been getting all along.
When I then put MSAU200.DLL back in place everybody was ok again..apart from "the 1". This proves to me that this file being in the install directory is what is needed to get the file open dialog to work...so why is this 1 person having a problem when they are all accesing the same shared drive ?
Paul C.
Paul,
<<This proves to
me that this file being in the install directory is what is needed to get the file open dialog to work...so
why is this 1 person having a problem when they are all accesing the same shared drive ?>>
Are they starting the app differently then the others? In other words, are you sure their current directory is set to the shared directory? Do they have adaquate rights to read all the files in the shared directory?
Jim.
<<This proves to
me that this file being in the install directory is what is needed to get the file open dialog to work...so
why is this 1 person having a problem when they are all accesing the same shared drive ?>>
Are they starting the app differently then the others? In other words, are you sure their current directory is set to the shared directory? Do they have adaquate rights to read all the files in the shared directory?
Jim.
ASKER
JDettman said:
"I think if you check one of the other machines that is working, you'll find the DLL is already somewhere
else on the PC"
...To test this I actually removed MSAU200.DLL from the shared installtion directory. Having done this the file open dialog didn't appear for anybody and they all got the error message that "the 1" has been getting all along.
When I then put MSAU200.DLL back in place everybody was ok again..apart from "the 1". This proves to me that this file being in the install directory is what is needed to get the file open dialog to work...so why is this 1 person having a problem when they are all accesing the same shared drive ?
Paul C.
"I think if you check one of the other machines that is working, you'll find the DLL is already somewhere
else on the PC"
...To test this I actually removed MSAU200.DLL from the shared installtion directory. Having done this the file open dialog didn't appear for anybody and they all got the error message that "the 1" has been getting all along.
When I then put MSAU200.DLL back in place everybody was ok again..apart from "the 1". This proves to me that this file being in the install directory is what is needed to get the file open dialog to work...so why is this 1 person having a problem when they are all accesing the same shared drive ?
Paul C.
ASKER
JDettman said:
"I think if you check one of the other machines that is working, you'll find the DLL is already somewhere
else on the PC"
...To test this I actually removed MSAU200.DLL from the shared installtion directory. Having done this the file open dialog didn't appear for anybody and they all got the error message that "the 1" has been getting all along.
When I then put MSAU200.DLL back in place everybody was ok again..apart from "the 1". This proves to me that this file being in the install directory is what is needed to get the file open dialog to work...so why is this 1 person having a problem when they are all accesing the same shared drive ?
Paul C.
"I think if you check one of the other machines that is working, you'll find the DLL is already somewhere
else on the PC"
...To test this I actually removed MSAU200.DLL from the shared installtion directory. Having done this the file open dialog didn't appear for anybody and they all got the error message that "the 1" has been getting all along.
When I then put MSAU200.DLL back in place everybody was ok again..apart from "the 1". This proves to me that this file being in the install directory is what is needed to get the file open dialog to work...so why is this 1 person having a problem when they are all accesing the same shared drive ?
Paul C.
Paul,
You keep repeating the same message which I already responded to.
Jim.
You keep repeating the same message which I already responded to.
Jim.
ASKER
yeh...I didn't mean too....just seems to keep adding itself on....he he.
Cheers,
PaulC.
Cheers,
PaulC.
Paul,
Don't use the refresh button. It will cause the page to be resubmitted.
Jim.
Don't use the refresh button. It will cause the page to be resubmitted.
Jim.
The dll might be referencing other dll's that are not on that one users pc. Download dependency walker from this link to check for that possiblity.
http://www.dependencywalker.com/
http://www.dependencywalker.com/
ASKER
ok...downloaded that...what do I do with it ? What do I use as the input file ?...I tried a .mdb...didn't like that.
PaulC.
PaulC.
Here are some function for open/save files or folders that use the windows conmmon API rather than the msaccess dll
Richard
Attribute VB_Name = "CommonDialogAPI"
Option Explicit
Private Const mcstrModule As String = "CES_basAPIGetData"
' Type for common dialog functions
Type CES_OPENFILENAME
lStructSize As Long
hWndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As String
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
' Private Variables
Declare Function MyGetOpenFileName Lib "COMDLG32.DLL" Alias "GetOpenFileNameA" (ofil As CES_OPENFILENAME) As Integer
Declare Function MyGetSaveFileName Lib "COMDLG32.DLL" Alias "GetSaveFileNameA" (ofil As CES_OPENFILENAME) As Integer
'Declare Function Mylstrcpy Lib "Kernel32" Alias "lstrcpyA" (ByVal DestString As String, ByVal SourceString As String) As Long
Declare Function MyCommDlgExtendedError Lib "COMDLG32.DLL" Alias "CommDlgExtendedError" () As Long
Declare Function Frog_GetActiveWindow Lib "user32" Alias "GetActiveWindow" () As Long
Private Declare Function apiWNetGetConnection Lib "mpr.dll" Alias "WNetGetConnectionA" _
(ByVal strLocalName As String, ByVal strRemoteName As String, _
ByRef rlngRemoteNameLen As Long) As Long
Private Const CMDLG_OFN_READONLY = &H1
Private Const CMDLG_OFN_OVERWRITEPROMPT = &H2
Private Const CMDLG_OFN_HIDEREADONLY = &H4
Private Const CMDLG_OFN_NOCHANGEDIR = &H8
Private Const CMDLG_OFN_SHOWHELP = &H10
Private Const CMDLG_OFN_ENABLEHOOK = &H20
Private Const CMDLG_OFN_ENABLETEMPLATE = &H40
Private Const CMDLG_OFN_ENABLETEMPLATEHA
Private Const CMDLG_OFN_NOVALIDATE = &H100
Private Const CMDLG_OFN_ALLOWMULTISELECT
Private Const CMDLG_OFN_EXTENSIONDIFFERE
Private Const CMDLG_OFN_PATHMUSTEXIST = &H800
Private Const CMDLG_OFN_FILEMUSTEXIST = &H1000
Private Const CMDLG_OFN_CREATEPROMPT = &H2000
Private Const CMDLG_OFN_SHAREAWARE = &H4000
Private Const CMDLG_OFN_NOREADONLYRETURN
Private Const CMDLG_OFN_NOTESTFILECREATE
Private Const CMDLG_OFN_SHAREFALLTHROUGH
Private Const CMDLG_OFN_SHARENOWARN = 1
Private Const CMDLG_OFN_SHAREWARN = 0
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
'Private Const BIF_BROWSEINCLUDEFILES = 4
Private Const MAX_PATH = 260
Private Declare Function SHBrowseForFolder Lib "Shell32" (lpbi As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "Shell32" (ByVal pidList As Long, _
ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" _
(ByVal lpString1 As String, ByVal _
lpString2 As String) As Long
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 Function API_Getfolder(ByRef pstrFolderName As String, ByVal pstrDialogTitle As String, Optional pbolUseUnc As Boolean = False) As Boolean
'Opens a Treeview control that displays the directories in a computer
'/////////////////////////
On Error GoTo API_Getfolder_Error
'/////////////////////////
'/////////////////////////
Dim lpIDList As Long
Dim strFolder As String
Dim szTitle As String
Dim tBrowseInfo As BROWSEINFO
Dim strSavefolder As String
'/////////////////////////
'/////////////////////////
'Assume the Worst
API_Getfolder = False
strSavefolder = CurDir()
szTitle = pstrDialogTitle
strFolder = pstrFolderName
If Len(pstrFolderName) > 0 Then
End If
With tBrowseInfo
.hWndOwner = Frog_GetActiveWindow()
.lpszTitle = lstrcat(szTitle, "")
' .pIDLRoot = lstrcat(strFolder, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN '+ BIF_BROWSEINCLUDEFILES
End With
lpIDList = SHBrowseForFolder(tBrowseI
If (lpIDList) Then
strFolder = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, strFolder
strFolder = Left(strFolder, InStr(strFolder, vbNullChar) - 1)
If Right(strFolder, 1) <> "\" Then
strFolder = strFolder & "\"
End If
If pbolUseUnc Then
pstrFolderName = GetUNCPath(strFolder)
Else
pstrFolderName = strFolder
End If
API_Getfolder = True
End If
'/////////////////////////
API_Getfolder_Exit:
On Error Resume Next
ChDir strSavefolder
Exit Function
'/////////////////////////
API_Getfolder_Error:
'// Display message number and text
Beep
MsgBox Err & vbCrLf & Error, 48, "Error in API_Getfolder"
Call ErrorLog(Err, Error, mcstrModule, "API_Getfolder")
'Resume '***Delete
Resume API_Getfolder_Exit
End Function
Function api_GetDataFile(pstrFileNa
'/////////////////////////
On Error GoTo API_GetDataFile_Error
'/////////////////////////
'/////////////////////////
Dim CMDLG_OPENFILENAME As CES_OPENFILENAME
Dim strMessage As String, strFilter As String, strFileName As String
Dim strFileTitle As String, strDefExt As String, strTitle As String, strMsg As String
Dim strCRLF As String, strSzCurDir As String, lngAPIResults As Long, intInput As Integer
Dim intX As Integer, strSysFileID As String, strPath As String
Dim strDrive As String
'/////////////////////////
'/////////////////////////
'
' assume the worst
api_GetDataFile = False
'strPath = pstrFileName
strCRLF = Chr$(13) & Chr$(10)
'*Define the filter string and allocate space in the "c" string
If pstrType = "dbf" Then
strFilter = "DBase iv (*.dbf)" & Chr(0) & "*.DBF" & Chr(0)
ElseIf pstrType = "mdb" Then
strFilter = "Access (*.mdb)" & Chr(0) & " *.MDB" & Chr(0)
ElseIf pstrType = "txt" Then
strFilter = "Text" & Chr(0) & "*.TXT" & Chr(0)
strFilter = strFilter & "Comma Seperated" & Chr(0) & "*.csv" & Chr(0)
ElseIf pstrType = "dot" Then
strFilter = "Word Template" & Chr(0) & " *.Dot" & Chr(0)
ElseIf pstrType = "xls" Then
strFilter = "Excel file" & Chr(0) & "*.xls" & Chr(0)
ElseIf pstrType = "xlt" Then
strFilter = "Excel Template" & Chr(0) & "*.xlt" & Chr(0)
Else
strFilter = pstrType & " Files" & Chr(0) & "*." & pstrType & Chr(0)
End If
strFilter = strFilter & "All Files (*.*)" & Chr(0) & "*.*" & Chr(0) & Chr(0)
'* Allocate string space for the returned strings.
If Len(pstrFileName) > 0 Then
strPath = GetFilePath(pstrFileName)
strFileName = Right(pstrFileName, (Len(pstrFileName) - Len(strPath)))
strFileName = strFileName & Space$(255 - Len(strFileName)) & Chr$(0)
Else
strFileName = Chr$(0) & Space$(255) & Chr$(0)
End If
strFileTitle = Chr$(0) & Space$(255) & Chr$(0)
'* Give the dialog a caption title.
strTitle = pstrDialogTitle & Chr$(0)
'* Set up the default directory
If Len(strPath) = 0 Then
strSzCurDir = Chr(0) & strPath & Chr$(0)
Else
strSzCurDir = strPath & Chr$(0)
End If
'* Set up the data structure before you call the GetOpenFileName
CMDLG_OPENFILENAME.lStruct
CMDLG_OPENFILENAME.hWndOwn
CMDLG_OPENFILENAME.hInstan
' CMDLG_OPENFILENAME.lpstrFi
CMDLG_OPENFILENAME.lpstrFi
CMDLG_OPENFILENAME.lpstrCu
CMDLG_OPENFILENAME.nMaxCus
CMDLG_OPENFILENAME.nFilter
CMDLG_OPENFILENAME.lpstrFi
CMDLG_OPENFILENAME.nMaxFil
CMDLG_OPENFILENAME.lpstrFi
' CMDLG_OPENFILENAME.lpstrFi
CMDLG_OPENFILENAME.nMaxFil
' CMDLG_OPENFILENAME.lpstrIn
CMDLG_OPENFILENAME.lpstrIn
' CMDLG_OPENFILENAME.lpstrTi
CMDLG_OPENFILENAME.lpstrTi
CMDLG_OPENFILENAME.Flags = CMDLG_OFN_FILEMUSTEXIST Or CMDLG_OFN_READONLY
' CMDLG_OPENFILENAME.lpstrDe
CMDLG_OPENFILENAME.lpstrDe
CMDLG_OPENFILENAME.nFileOf
CMDLG_OPENFILENAME.nFileEx
CMDLG_OPENFILENAME.lCustDa
CMDLG_OPENFILENAME.lpfnHoo
CMDLG_OPENFILENAME.lpTempl
'* This will pass the desired data structure to the Windows API,
'* which will in turn use it to display the Open Dialog form.
lngAPIResults = MyGetOpenFileName(CMDLG_OP
If lngAPIResults <> 0 Then
strFileName = CMDLG_OPENFILENAME.lpstrFi
strFileName = Left$(strFileName, InStr(strFileName, Chr$(0)) - 1)
If pbolUseUnc Then
pstrFileName = GetUNCPath(strFileName)
Else
pstrFileName = strFileName
End If
Else
GoTo API_GetDataFile_Exit
End If
API_GetDataFile_Success:
api_GetDataFile = True
'/////////////////////////
API_GetDataFile_Exit:
On Error Resume Next
Exit Function
'/////////////////////////
API_GetDataFile_Error:
'// Display message number and text
Beep
If Err = 68 Then
MsgBox ("Unable to connect to network drive.. Please contact your system administrator."), 64, ("Drive Error")
Else
MsgBox Err & Chr$(13) & Error, 48, "Error in API_GetDataFile"
End If
Resume API_GetDataFile_Exit
End Function
Function api_SaveDataFile(pstrFileN
'/////////////////////////
On Error GoTo API_SaveDataFile_Error
'/////////////////////////
'/////////////////////////
Dim CMDLG_OPENFILENAME As CES_OPENFILENAME
Dim strMessage As String, strFilter As String, strFileName As String
Dim strFileTitle As String, strDefExt As String, strTitle As String, strMsg As String
Dim strCRLF As String, strSzCurDir As String, lngAPIResults As Long, intInput As Integer
Dim intX As Integer, strSysFileID As String, strPath As String
Dim strDrive As String
'/////////////////////////
'/////////////////////////
'
' assume the worst
api_SaveDataFile = False
strPath = pstrFileName
strCRLF = Chr$(13) & Chr$(10)
'*Define the filter string and allocate space in the "c" string
If pstrType = "dbf" Then
strFilter = "DBase iv (*.dbf)" & Chr(0) & "*.DBF" & Chr(0)
ElseIf pstrType = "mdb" Then
strFilter = "Access (*.mdb)" & Chr(0) & " *.MDB" & Chr(0)
ElseIf pstrType = "txt" Then
strFilter = "Text" & Chr(0) & "*.TXT" & Chr(0)
strFilter = strFilter & "Comma Seperated" & Chr(0) & "*.csv" & Chr(0)
ElseIf pstrType = "Doc" Then
strFilter = "Word Document" & Chr(0) & "*.DOC" & Chr(0)
strFilter = strFilter & "RTF" & Chr(0) & "*.rtf" & Chr(0)
ElseIf pstrType = "xls" Then
strFilter = "Excel Workbook" & Chr(0) & "*.xls" & Chr(0)
Else
strFilter = pstrType & " Files" & Chr(0) & "*." & pstrType & Chr(0)
End If
strDefExt = pstrType & Chr$(0)
strFilter = strFilter & "All Files (*.*)" & Chr(0) & "*.*" & Chr(0) & Chr(0)
'* Allocate string space for the returned strings.
If Len(pstrFileName) > 0 Then
' strPath = pstrFileName
strPath = GetFilePath(pstrFileName)
strFileName = Right(pstrFileName, (Len(pstrFileName) - Len(strPath)))
strFileName = strFileName & Space$(255 - Len(strFileName)) & Chr$(0)
Else
strFileName = Chr$(0) & Space$(255) & Chr$(0)
End If
strFileTitle = Chr$(0) & Space$(255) & Chr$(0)
'* Give the dialog a caption title.
strTitle = pstrDialogTitle & Chr$(0)
'* Set up the default directory
If Len(strPath) = 0 Then
strSzCurDir = Chr(0) & strPath & Chr$(0)
Else
strSzCurDir = strPath & Chr$(0)
End If
'* Set up the data structure before you call the GetOpenFileName
CMDLG_OPENFILENAME.lStruct
CMDLG_OPENFILENAME.hWndOwn
CMDLG_OPENFILENAME.hInstan
CMDLG_OPENFILENAME.lpstrFi
CMDLG_OPENFILENAME.lpstrCu
CMDLG_OPENFILENAME.nMaxCus
CMDLG_OPENFILENAME.nFilter
CMDLG_OPENFILENAME.lpstrFi
CMDLG_OPENFILENAME.nMaxFil
CMDLG_OPENFILENAME.lpstrFi
CMDLG_OPENFILENAME.nMaxFil
CMDLG_OPENFILENAME.lpstrIn
CMDLG_OPENFILENAME.lpstrTi
CMDLG_OPENFILENAME.Flags = CMDLG_OFN_PATHMUSTEXIST Or CMDLG_OFN_READONLY Or CMDLG_OFN_OVERWRITEPROMPT
CMDLG_OPENFILENAME.lpstrDe
CMDLG_OPENFILENAME.nFileOf
CMDLG_OPENFILENAME.nFileEx
CMDLG_OPENFILENAME.lCustDa
CMDLG_OPENFILENAME.lpfnHoo
CMDLG_OPENFILENAME.lpTempl
'* This will pass the desired data structure to the Windows API,
'* which will in turn use it to display the Open Dialog form.
lngAPIResults = MyGetSaveFileName(CMDLG_OP
If lngAPIResults <> 0 Then
strFileName = CMDLG_OPENFILENAME.lpstrFi
strFileName = Left$(strFileName, InStr(strFileName, Chr$(0)) - 1)
If pbolUseUnc Then
pstrFileName = GetUNCPath(strFileName)
pstrFileName = strFileName
End If
Else
GoTo API_SaveDataFile_Exit
End If
API_SaveDataFile_Success:
api_SaveDataFile = True
'/////////////////////////
API_SaveDataFile_Exit:
On Error Resume Next
Exit Function
'/////////////////////////
API_SaveDataFile_Error:
'// Display message number and text
Beep
If Err = 68 Then
MsgBox ("Unable to connect to network drive.. Please contact your system administrator."), 64, ("Drive Error")
Else
MsgBox Err & Chr$(13) & Error, 48, "Error in API_SaveDataFile"
End If
Resume API_SaveDataFile_Exit
End Function
Private Function GetUNCPath(ByVal strPath As String) As String
'Note, this function will only return the UNC for network drives.
'Non-net drives and errors get the original value returned to them
On Error GoTo Err_GetUNC
Const lngcBuffer As Long = 257
Dim strUNCPath As String
Dim strDrive As String
If Left(strPath, 2) Like "[a-z, A-Z]:" Then
strDrive = Left(strPath, 2)
strUNCPath = strUNCPath & Space(lngcBuffer)
'The function will automatically fill the strUNCPath unless there
'is an error (return<>0), fill strPath if error
If apiWNetGetConnection(strDr
strUNCPath = TrimNull(strUNCPath) & Mid(strPath, 3)
Else
strUNCPath = strPath
End If
End If
If Len(Trim(strUNCPath)) = 0 Then strUNCPath = strPath
GetUNCPath = strUNCPath
Exit_GetUNC:
Exit Function
Err_GetUNC:
MsgBox "Error " & Err.Number & " " & Err.Description
Resume Exit_GetUNC
End Function
Private Function TrimNull(ByVal strNullTermString As String) As String
'This function is used to return a string from a DLL null-terminated string
On Error GoTo Err_TrimNull
Dim lngNullPos As Long
lngNullPos = InStr(strNullTermString, vbNullChar)
If lngNullPos > 0 Then
TrimNull = Left(strNullTermString, lngNullPos - 1)
Else
TrimNull = strNullTermString
End If
Exit_TrimNull:
Exit Function
Err_TrimNull:
MsgBox "Error " & Err.Number & " " & Err.Description
Resume Exit_TrimNull
End Function
Public Function GetFilePath(ByVal pstrFileName As String) As String
Dim intX As Integer, intY As Integer
Dim strPath As String
intX = 1
intX = InStr(intX, pstrFileName, "\")
Do While intX > 0
strPath = Left(pstrFileName, intX)
intX = InStr(intX + 1, pstrFileName, "\")
Loop
GetFilePath = strPath
End Function
Richard
Attribute VB_Name = "CommonDialogAPI"
Option Explicit
Private Const mcstrModule As String = "CES_basAPIGetData"
' Type for common dialog functions
Type CES_OPENFILENAME
lStructSize As Long
hWndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As String
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
' Private Variables
Declare Function MyGetOpenFileName Lib "COMDLG32.DLL" Alias "GetOpenFileNameA" (ofil As CES_OPENFILENAME) As Integer
Declare Function MyGetSaveFileName Lib "COMDLG32.DLL" Alias "GetSaveFileNameA" (ofil As CES_OPENFILENAME) As Integer
'Declare Function Mylstrcpy Lib "Kernel32" Alias "lstrcpyA" (ByVal DestString As String, ByVal SourceString As String) As Long
Declare Function MyCommDlgExtendedError Lib "COMDLG32.DLL" Alias "CommDlgExtendedError" () As Long
Declare Function Frog_GetActiveWindow Lib "user32" Alias "GetActiveWindow" () As Long
Private Declare Function apiWNetGetConnection Lib "mpr.dll" Alias "WNetGetConnectionA" _
(ByVal strLocalName As String, ByVal strRemoteName As String, _
ByRef rlngRemoteNameLen As Long) As Long
Private Const CMDLG_OFN_READONLY = &H1
Private Const CMDLG_OFN_OVERWRITEPROMPT = &H2
Private Const CMDLG_OFN_HIDEREADONLY = &H4
Private Const CMDLG_OFN_NOCHANGEDIR = &H8
Private Const CMDLG_OFN_SHOWHELP = &H10
Private Const CMDLG_OFN_ENABLEHOOK = &H20
Private Const CMDLG_OFN_ENABLETEMPLATE = &H40
Private Const CMDLG_OFN_ENABLETEMPLATEHA
Private Const CMDLG_OFN_NOVALIDATE = &H100
Private Const CMDLG_OFN_ALLOWMULTISELECT
Private Const CMDLG_OFN_EXTENSIONDIFFERE
Private Const CMDLG_OFN_PATHMUSTEXIST = &H800
Private Const CMDLG_OFN_FILEMUSTEXIST = &H1000
Private Const CMDLG_OFN_CREATEPROMPT = &H2000
Private Const CMDLG_OFN_SHAREAWARE = &H4000
Private Const CMDLG_OFN_NOREADONLYRETURN
Private Const CMDLG_OFN_NOTESTFILECREATE
Private Const CMDLG_OFN_SHAREFALLTHROUGH
Private Const CMDLG_OFN_SHARENOWARN = 1
Private Const CMDLG_OFN_SHAREWARN = 0
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
'Private Const BIF_BROWSEINCLUDEFILES = 4
Private Const MAX_PATH = 260
Private Declare Function SHBrowseForFolder Lib "Shell32" (lpbi As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "Shell32" (ByVal pidList As Long, _
ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" _
(ByVal lpString1 As String, ByVal _
lpString2 As String) As Long
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 Function API_Getfolder(ByRef pstrFolderName As String, ByVal pstrDialogTitle As String, Optional pbolUseUnc As Boolean = False) As Boolean
'Opens a Treeview control that displays the directories in a computer
'/////////////////////////
On Error GoTo API_Getfolder_Error
'/////////////////////////
'/////////////////////////
Dim lpIDList As Long
Dim strFolder As String
Dim szTitle As String
Dim tBrowseInfo As BROWSEINFO
Dim strSavefolder As String
'/////////////////////////
'/////////////////////////
'Assume the Worst
API_Getfolder = False
strSavefolder = CurDir()
szTitle = pstrDialogTitle
strFolder = pstrFolderName
If Len(pstrFolderName) > 0 Then
End If
With tBrowseInfo
.hWndOwner = Frog_GetActiveWindow()
.lpszTitle = lstrcat(szTitle, "")
' .pIDLRoot = lstrcat(strFolder, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN '+ BIF_BROWSEINCLUDEFILES
End With
lpIDList = SHBrowseForFolder(tBrowseI
If (lpIDList) Then
strFolder = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, strFolder
strFolder = Left(strFolder, InStr(strFolder, vbNullChar) - 1)
If Right(strFolder, 1) <> "\" Then
strFolder = strFolder & "\"
End If
If pbolUseUnc Then
pstrFolderName = GetUNCPath(strFolder)
Else
pstrFolderName = strFolder
End If
API_Getfolder = True
End If
'/////////////////////////
API_Getfolder_Exit:
On Error Resume Next
ChDir strSavefolder
Exit Function
'/////////////////////////
API_Getfolder_Error:
'// Display message number and text
Beep
MsgBox Err & vbCrLf & Error, 48, "Error in API_Getfolder"
Call ErrorLog(Err, Error, mcstrModule, "API_Getfolder")
'Resume '***Delete
Resume API_Getfolder_Exit
End Function
Function api_GetDataFile(pstrFileNa
'/////////////////////////
On Error GoTo API_GetDataFile_Error
'/////////////////////////
'/////////////////////////
Dim CMDLG_OPENFILENAME As CES_OPENFILENAME
Dim strMessage As String, strFilter As String, strFileName As String
Dim strFileTitle As String, strDefExt As String, strTitle As String, strMsg As String
Dim strCRLF As String, strSzCurDir As String, lngAPIResults As Long, intInput As Integer
Dim intX As Integer, strSysFileID As String, strPath As String
Dim strDrive As String
'/////////////////////////
'/////////////////////////
'
' assume the worst
api_GetDataFile = False
'strPath = pstrFileName
strCRLF = Chr$(13) & Chr$(10)
'*Define the filter string and allocate space in the "c" string
If pstrType = "dbf" Then
strFilter = "DBase iv (*.dbf)" & Chr(0) & "*.DBF" & Chr(0)
ElseIf pstrType = "mdb" Then
strFilter = "Access (*.mdb)" & Chr(0) & " *.MDB" & Chr(0)
ElseIf pstrType = "txt" Then
strFilter = "Text" & Chr(0) & "*.TXT" & Chr(0)
strFilter = strFilter & "Comma Seperated" & Chr(0) & "*.csv" & Chr(0)
ElseIf pstrType = "dot" Then
strFilter = "Word Template" & Chr(0) & " *.Dot" & Chr(0)
ElseIf pstrType = "xls" Then
strFilter = "Excel file" & Chr(0) & "*.xls" & Chr(0)
ElseIf pstrType = "xlt" Then
strFilter = "Excel Template" & Chr(0) & "*.xlt" & Chr(0)
Else
strFilter = pstrType & " Files" & Chr(0) & "*." & pstrType & Chr(0)
End If
strFilter = strFilter & "All Files (*.*)" & Chr(0) & "*.*" & Chr(0) & Chr(0)
'* Allocate string space for the returned strings.
If Len(pstrFileName) > 0 Then
strPath = GetFilePath(pstrFileName)
strFileName = Right(pstrFileName, (Len(pstrFileName) - Len(strPath)))
strFileName = strFileName & Space$(255 - Len(strFileName)) & Chr$(0)
Else
strFileName = Chr$(0) & Space$(255) & Chr$(0)
End If
strFileTitle = Chr$(0) & Space$(255) & Chr$(0)
'* Give the dialog a caption title.
strTitle = pstrDialogTitle & Chr$(0)
'* Set up the default directory
If Len(strPath) = 0 Then
strSzCurDir = Chr(0) & strPath & Chr$(0)
Else
strSzCurDir = strPath & Chr$(0)
End If
'* Set up the data structure before you call the GetOpenFileName
CMDLG_OPENFILENAME.lStruct
CMDLG_OPENFILENAME.hWndOwn
CMDLG_OPENFILENAME.hInstan
' CMDLG_OPENFILENAME.lpstrFi
CMDLG_OPENFILENAME.lpstrFi
CMDLG_OPENFILENAME.lpstrCu
CMDLG_OPENFILENAME.nMaxCus
CMDLG_OPENFILENAME.nFilter
CMDLG_OPENFILENAME.lpstrFi
CMDLG_OPENFILENAME.nMaxFil
CMDLG_OPENFILENAME.lpstrFi
' CMDLG_OPENFILENAME.lpstrFi
CMDLG_OPENFILENAME.nMaxFil
' CMDLG_OPENFILENAME.lpstrIn
CMDLG_OPENFILENAME.lpstrIn
' CMDLG_OPENFILENAME.lpstrTi
CMDLG_OPENFILENAME.lpstrTi
CMDLG_OPENFILENAME.Flags = CMDLG_OFN_FILEMUSTEXIST Or CMDLG_OFN_READONLY
' CMDLG_OPENFILENAME.lpstrDe
CMDLG_OPENFILENAME.lpstrDe
CMDLG_OPENFILENAME.nFileOf
CMDLG_OPENFILENAME.nFileEx
CMDLG_OPENFILENAME.lCustDa
CMDLG_OPENFILENAME.lpfnHoo
CMDLG_OPENFILENAME.lpTempl
'* This will pass the desired data structure to the Windows API,
'* which will in turn use it to display the Open Dialog form.
lngAPIResults = MyGetOpenFileName(CMDLG_OP
If lngAPIResults <> 0 Then
strFileName = CMDLG_OPENFILENAME.lpstrFi
strFileName = Left$(strFileName, InStr(strFileName, Chr$(0)) - 1)
If pbolUseUnc Then
pstrFileName = GetUNCPath(strFileName)
Else
pstrFileName = strFileName
End If
Else
GoTo API_GetDataFile_Exit
End If
API_GetDataFile_Success:
api_GetDataFile = True
'/////////////////////////
API_GetDataFile_Exit:
On Error Resume Next
Exit Function
'/////////////////////////
API_GetDataFile_Error:
'// Display message number and text
Beep
If Err = 68 Then
MsgBox ("Unable to connect to network drive.. Please contact your system administrator."), 64, ("Drive Error")
Else
MsgBox Err & Chr$(13) & Error, 48, "Error in API_GetDataFile"
End If
Resume API_GetDataFile_Exit
End Function
Function api_SaveDataFile(pstrFileN
'/////////////////////////
On Error GoTo API_SaveDataFile_Error
'/////////////////////////
'/////////////////////////
Dim CMDLG_OPENFILENAME As CES_OPENFILENAME
Dim strMessage As String, strFilter As String, strFileName As String
Dim strFileTitle As String, strDefExt As String, strTitle As String, strMsg As String
Dim strCRLF As String, strSzCurDir As String, lngAPIResults As Long, intInput As Integer
Dim intX As Integer, strSysFileID As String, strPath As String
Dim strDrive As String
'/////////////////////////
'/////////////////////////
'
' assume the worst
api_SaveDataFile = False
strPath = pstrFileName
strCRLF = Chr$(13) & Chr$(10)
'*Define the filter string and allocate space in the "c" string
If pstrType = "dbf" Then
strFilter = "DBase iv (*.dbf)" & Chr(0) & "*.DBF" & Chr(0)
ElseIf pstrType = "mdb" Then
strFilter = "Access (*.mdb)" & Chr(0) & " *.MDB" & Chr(0)
ElseIf pstrType = "txt" Then
strFilter = "Text" & Chr(0) & "*.TXT" & Chr(0)
strFilter = strFilter & "Comma Seperated" & Chr(0) & "*.csv" & Chr(0)
ElseIf pstrType = "Doc" Then
strFilter = "Word Document" & Chr(0) & "*.DOC" & Chr(0)
strFilter = strFilter & "RTF" & Chr(0) & "*.rtf" & Chr(0)
ElseIf pstrType = "xls" Then
strFilter = "Excel Workbook" & Chr(0) & "*.xls" & Chr(0)
Else
strFilter = pstrType & " Files" & Chr(0) & "*." & pstrType & Chr(0)
End If
strDefExt = pstrType & Chr$(0)
strFilter = strFilter & "All Files (*.*)" & Chr(0) & "*.*" & Chr(0) & Chr(0)
'* Allocate string space for the returned strings.
If Len(pstrFileName) > 0 Then
' strPath = pstrFileName
strPath = GetFilePath(pstrFileName)
strFileName = Right(pstrFileName, (Len(pstrFileName) - Len(strPath)))
strFileName = strFileName & Space$(255 - Len(strFileName)) & Chr$(0)
Else
strFileName = Chr$(0) & Space$(255) & Chr$(0)
End If
strFileTitle = Chr$(0) & Space$(255) & Chr$(0)
'* Give the dialog a caption title.
strTitle = pstrDialogTitle & Chr$(0)
'* Set up the default directory
If Len(strPath) = 0 Then
strSzCurDir = Chr(0) & strPath & Chr$(0)
Else
strSzCurDir = strPath & Chr$(0)
End If
'* Set up the data structure before you call the GetOpenFileName
CMDLG_OPENFILENAME.lStruct
CMDLG_OPENFILENAME.hWndOwn
CMDLG_OPENFILENAME.hInstan
CMDLG_OPENFILENAME.lpstrFi
CMDLG_OPENFILENAME.lpstrCu
CMDLG_OPENFILENAME.nMaxCus
CMDLG_OPENFILENAME.nFilter
CMDLG_OPENFILENAME.lpstrFi
CMDLG_OPENFILENAME.nMaxFil
CMDLG_OPENFILENAME.lpstrFi
CMDLG_OPENFILENAME.nMaxFil
CMDLG_OPENFILENAME.lpstrIn
CMDLG_OPENFILENAME.lpstrTi
CMDLG_OPENFILENAME.Flags = CMDLG_OFN_PATHMUSTEXIST Or CMDLG_OFN_READONLY Or CMDLG_OFN_OVERWRITEPROMPT
CMDLG_OPENFILENAME.lpstrDe
CMDLG_OPENFILENAME.nFileOf
CMDLG_OPENFILENAME.nFileEx
CMDLG_OPENFILENAME.lCustDa
CMDLG_OPENFILENAME.lpfnHoo
CMDLG_OPENFILENAME.lpTempl
'* This will pass the desired data structure to the Windows API,
'* which will in turn use it to display the Open Dialog form.
lngAPIResults = MyGetSaveFileName(CMDLG_OP
If lngAPIResults <> 0 Then
strFileName = CMDLG_OPENFILENAME.lpstrFi
strFileName = Left$(strFileName, InStr(strFileName, Chr$(0)) - 1)
If pbolUseUnc Then
pstrFileName = GetUNCPath(strFileName)
pstrFileName = strFileName
End If
Else
GoTo API_SaveDataFile_Exit
End If
API_SaveDataFile_Success:
api_SaveDataFile = True
'/////////////////////////
API_SaveDataFile_Exit:
On Error Resume Next
Exit Function
'/////////////////////////
API_SaveDataFile_Error:
'// Display message number and text
Beep
If Err = 68 Then
MsgBox ("Unable to connect to network drive.. Please contact your system administrator."), 64, ("Drive Error")
Else
MsgBox Err & Chr$(13) & Error, 48, "Error in API_SaveDataFile"
End If
Resume API_SaveDataFile_Exit
End Function
Private Function GetUNCPath(ByVal strPath As String) As String
'Note, this function will only return the UNC for network drives.
'Non-net drives and errors get the original value returned to them
On Error GoTo Err_GetUNC
Const lngcBuffer As Long = 257
Dim strUNCPath As String
Dim strDrive As String
If Left(strPath, 2) Like "[a-z, A-Z]:" Then
strDrive = Left(strPath, 2)
strUNCPath = strUNCPath & Space(lngcBuffer)
'The function will automatically fill the strUNCPath unless there
'is an error (return<>0), fill strPath if error
If apiWNetGetConnection(strDr
strUNCPath = TrimNull(strUNCPath) & Mid(strPath, 3)
Else
strUNCPath = strPath
End If
End If
If Len(Trim(strUNCPath)) = 0 Then strUNCPath = strPath
GetUNCPath = strUNCPath
Exit_GetUNC:
Exit Function
Err_GetUNC:
MsgBox "Error " & Err.Number & " " & Err.Description
Resume Exit_GetUNC
End Function
Private Function TrimNull(ByVal strNullTermString As String) As String
'This function is used to return a string from a DLL null-terminated string
On Error GoTo Err_TrimNull
Dim lngNullPos As Long
lngNullPos = InStr(strNullTermString, vbNullChar)
If lngNullPos > 0 Then
TrimNull = Left(strNullTermString, lngNullPos - 1)
Else
TrimNull = strNullTermString
End If
Exit_TrimNull:
Exit Function
Err_TrimNull:
MsgBox "Error " & Err.Number & " " & Err.Description
Resume Exit_TrimNull
End Function
Public Function GetFilePath(ByVal pstrFileName As String) As String
Dim intX As Integer, intY As Integer
Dim strPath As String
intX = 1
intX = InStr(intX, pstrFileName, "\")
Do While intX > 0
strPath = Left(pstrFileName, intX)
intX = InStr(intX + 1, pstrFileName, "\")
Loop
GetFilePath = strPath
End Function
No comment has been added lately, so it's time to clean up this TA.
I will leave a recommendation in Community Support that this question is:
- PAQ'd and pts refunded
Please leave any comments here within the
next seven days.
PLEASE DO NOT ACCEPT THIS COMMENT AS AN ANSWER !
Nic;o)
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Does the one user have a runtime install of Access rather then the full version?
I think if you check one of the other machines that is working, you'll find the DLL is already somewhere else on the PC.
The only other thing I can think of is that Access searches the current directory first, then the windows directory and then \windows\system for DLLs, and after that the path statement (may have that last part backwards).
When starting the app, make sure the "Start in" is correctly set for the shortcut, or do an explicit CD to the correct directory in the app.
Jim.