Go Back   Access World Forums > Microsoft Access Discussion > Modules & VBA

 
Reply
 
Thread Tools Rate Thread Display Modes
Old 04-04-2011, 08:54 AM   #1
Thorope
Newly Registered User
 
Join Date: Nov 2010
Posts: 7
Thanks: 0
Thanked 0 Times in 0 Posts
Thorope is on a distinguished road
Question Access Code & Module 32bit to 64bit system - Browse For File Code

Hello,
I have a problem with my database i have designed, its a piece of code that allows you to browse for a .csv file, it worked in Access 2010 32bit system but when i upgraded to Access 2010 64bit it says there is slightly different code, so i looked it up and see what i could do to try and make it work... nothing worked... adding Ptr to it did nothing as that is what i was told to add in some places...
So im hoping if i put the code & module here some on will try and fix it fore me...

Thanks in advance

Code Pieces

(I have Tried putting Ptr where asked as you can see below, if im wrong please do correct)
######### Module ##########
Code:
Option Compare Database
Option Explicit

Private Declare PtrSafe Function ts_apiGetOpenFileName Lib "comdlg32.ocx" _
 Alias "GetOpenFileNameA" (tsFN As tsFileName) As Boolean

Private Declare PtrSafe Function ts_apiGetSaveFileName Lib "comdlg32.ocx" _
 Alias "GetSaveFileNameA" (tsFN As tsFileName) As Boolean

Private Declare PtrSafe Function CommDlgExtendedError Lib "comdlg32.ocx" () As Long

Private Type tsFileName
   lStructSize As Long
   hwndOwner As Long
   hInstance As Long
   strFilter As String
   strCustomFilter As String
   nMaxCustFilter As Long
   nFilterIndex As Long
   strFile As String
   nMaxFile As Long
   strFileTitle As String
   nMaxFileTitle As Long
   strInitialDir As String
   strTitle As String
   flags As Long
   nFileOffset As Integer
   nFileExtension As Integer
   strDefExt As String
   lCustData As Long
   lpfnHook As Long
   lpTemplateName As String
End Type

' Flag Constants
Public Const tscFNAllowMultiSelect = &H200
Public Const tscFNCreatePrompt = &H2000
Public Const tscFNExplorer = &H80000
Public Const tscFNExtensionDifferent = &H400
Public Const tscFNFileMustExist = &H1000
Public Const tscFNPathMustExist = &H800
Public Const tscFNNoValidate = &H100
Public Const tscFNHelpButton = &H10
Public Const tscFNHideReadOnly = &H4
Public Const tscFNLongNames = &H200000
Public Const tscFNNoLongNames = &H40000
Public Const tscFNNoChangeDir = &H8
Public Const tscFNReadOnly = &H1
Public Const tscFNOverwritePrompt = &H2
Public Const tscFNShareAware = &H4000
Public Const tscFNNoReadOnlyReturn = &H8000
Public Const tscFNNoDereferenceLinks = &H100000

Public Function tsGetFileFromUser( _
    Optional ByRef rlngflags As Long = 0&, _
    Optional ByVal strInitialDir As String = "", _
    Optional ByVal strFilter As String = "All Files (*.*)" & vbNullChar & "*.*", _
    Optional ByVal lngFilterIndex As Long = 1, _
    Optional ByVal strDefaultExt As String = "", _
    Optional ByVal strFileName As String = "", _
    Optional ByVal strDialogTitle As String = "", _
    Optional ByVal fOpenFile As Boolean = True) As Variant
On Error GoTo tsGetFileFromUser_Err
    
    Dim tsFN As tsFileName
    Dim strFileTitle As String
    Dim fResult As Boolean

    ' Allocate string space for the returned strings.
    strFileName = Left(strFileName & String(256, 0), 256)
    strFileTitle = String(256, 0)

    ' Set up the data structure before you call the function
    With tsFN
        .lStructSize = Len(tsFN)
        .hwndOwner = Application.hWndAccessApp
        .strFilter = strFilter
        .nFilterIndex = lngFilterIndex
        .strFile = strFileName
        .nMaxFile = Len(strFileName)
        .strFileTitle = strFileTitle
        .nMaxFileTitle = Len(strFileTitle)
        .strTitle = strDialogTitle
        .flags = rlngflags
        .strDefExt = strDefaultExt
        .strInitialDir = strInitialDir
        .hInstance = 0
        .strCustomFilter = String(255, 0)
        .nMaxCustFilter = 255
        .lpfnHook = 0
    End With
   
    ' Call the function in the windows API
    If fOpenFile Then
        fResult = ts_apiGetOpenFileName(tsFN)
    Else
        fResult = ts_apiGetSaveFileName(tsFN)
    End If

    ' If the function call was successful, return the FileName chosen
    ' by the user.  Otherwise return null.  Note, the CancelError property
    ' used by the ActiveX Common Dialog control is not needed.  If the
    ' user presses Cancel, this function will return Null.
    If fResult Then
        rlngflags = tsFN.flags
        tsGetFileFromUser = tsTrimNull(tsFN.strFile)
    Else
        tsGetFileFromUser = Null
    End If

tsGetFileFromUser_End:
    On Error GoTo 0
    Exit Function

tsGetFileFromUser_Err:
    Beep
    MsgBox Err.Description, , "Error: " & Err.Number _
    & " in function basBrowseFiles.tsGetFileFromUser"
    Resume tsGetFileFromUser_End

End Function

' Trim Nulls from a string returned by an API call.
Private Function tsTrimNull(ByVal strItem As String) As String
On Error GoTo tsTrimNull_Err
    Dim I As Integer
   
    I = InStr(strItem, vbNullChar)
    If I > 0 Then
        tsTrimNull = Left(strItem, I - 1)
    Else
        tsTrimNull = strItem
    End If
    
tsTrimNull_End:
    On Error GoTo 0
    Exit Function

tsTrimNull_Err:
    Beep
    MsgBox Err.Description, , "Error: " & Err.Number _
    & " in function basBrowseFiles.tsTrimNull"
    Resume tsTrimNull_End

End Function


Public Sub tsGetFileFromUserTest()
On Error GoTo tsGetFileFromUserTest_Err
   
    Dim strFilter As String
    Dim lngFlags As Long
    Dim varFileName As Variant

'   strFilter = "Access (*.mdb)" & vbNullChar & "*.mdb" _
'    & vbNullChar & "All Files (*.*)" & vbNullChar & "*.*"
    strFilter = "All Files (*.*)" & vbNullChar & "*.*"

    lngFlags = tscFNPathMustExist Or tscFNFileMustExist Or tscFNHideReadOnly
   
    varFileName = tsGetFileFromUser( _
    fOpenFile:=True, _
    strFilter:=strFilter, _
    rlngflags:=lngFlags, _
    strDialogTitle:="GetFileFromUser Test (Please choose a file)")
   
    If IsNull(varFileName) Then
        Debug.Print "User pressed 'Cancel'."
    Else
        Debug.Print varFileName
        'Forms![Form1]![Text1] = varFileName
    End If

    If varFileName <> "" Then MsgBox "You selected the '" & varFileName & "' file.", vbInformation

tsGetFileFromUserTest_End:
    On Error GoTo 0
    Exit Sub

tsGetFileFromUserTest_Err:
    Beep
    MsgBox Err.Description, , "Error: " & Err.Number _
     & " in sub basBrowseFiles.tsGetFileFromUserTest"
    Resume tsGetFileFromUserTest_End

End Sub
######### Button Code ######
Code:
Private Sub Command20_Click()
 Dim strFilter As String
    Dim lngFlags As Long
    Dim varFileName As Variant

    Me.tbHidden.SetFocus

   'strFilter = "Access (*.mdb)" & vbNullChar & "*.mdb" _
   ' & vbNullChar & "All Files (*.*)" & vbNullChar & "*.*"
    strFilter = "CSV File (*.csv)" & vbNullChar & "*.csv*"
    ' strFilter = "All Files (*.*)" & vbNullChar & "*.*"

    lngFlags = tscFNPathMustExist Or tscFNFileMustExist Or tscFNHideReadOnly

    varFileName = tsGetFileFromUser( _
    fOpenFile:=True, _
    strFilter:=strFilter, _
    rlngflags:=lngFlags, _
    strInitialDir:="C:\Users\James\Documents\Dock\Folders\6th Form Year 12\ICT Diploma\Mr Bush - Unit 4\eRadio Project\eRadio Project documents", _
    strDialogTitle:="Find File (Select The File And Click The Open Button)")
    'remove the strInitialDir:="C:\Windows\", _ line if you do not want the Browser to open at a specific location

    If IsNull(varFileName) Or varFileName = "" Then
        Debug.Print "User pressed 'Cancel'."
        Beep
        MsgBox "File selection was canceled.", vbInformation
        Exit Sub
    Else
        'Debug.Print varFileName
        Me.txtSelectedFile = varFileName
    End If

End Sub

Thorope is offline   Reply With Quote
Old 04-04-2011, 08:56 AM   #2
Banana
split with a cherry atop.
 
Join Date: Sep 2005
Posts: 6,315
Thanks: 0
Thanked 90 Times in 72 Posts
Banana is a name known to all Banana is a name known to all Banana is a name known to all Banana is a name known to all Banana is a name known to all Banana is a name known to all
Re: Access Code & Module 32bit to 64bit system - Browse For File Code

Have a look at this post.
__________________
If relation-valued attributes and arbitrarily complex types are wrong, then I don't wanna to be right!
Founder of 'Blame the Developers First' crowd.


To view links or images in signatures your post count must be 10 or greater. You currently have 0 posts.
Banana is offline   Reply With Quote
Old 04-04-2011, 09:13 AM   #3
Thorope
Newly Registered User
 
Join Date: Nov 2010
Posts: 7
Thanks: 0
Thanked 0 Times in 0 Posts
Thorope is on a distinguished road
Re: Access Code & Module 32bit to 64bit system - Browse For File Code

Thanks for the quick response, i looked at the website you gave and i understand it and changed the things that looks like needed to be changed but it still doesn't work, i would still have some one actually change it for me, im not Amazing at Coding like the rest of you :P

Thanks again.

Thorope is offline   Reply With Quote
Reply

Tags
64bit , button , code , module , system

Thread Tools
Display Modes Rate This Thread
Rate This Thread:

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Question Bar Code system and Access Joe8915 General 13 12-14-2010 08:16 AM
Cannot view code in Access Module wallaseawez Modules & VBA 12 08-18-2009 01:28 AM
export module as .bas file with vba code rob.low Modules & VBA 6 06-16-2009 02:35 AM
Browse [Find a directory or file] Code Norstar2 General 5 12-12-2006 06:02 AM
Code for "Browse" feature like Windows when saving a File. msiqbal Modules & VBA 4 11-16-2003 08:32 AM




All times are GMT -8. The time now is 11:24 AM.


Microsoft Access Help
General
Tables
Queries
Forms
Reports
Macros
Modules & VBA
Theory & Practice
Access FAQs
Code Repository
Sample Databases
Video Tutorials

Featured Forum post


Sponsored Links


Powered by vBulletin®
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
(c) copyright 2017 Access World