Import an Excel file (by search)

ECEK

Registered User.
Local time
Today, 11:41
Joined
Dec 19, 2012
Messages
717
I want to ImportExportSpreadsheet but I want the user to be able to navigate to the folder (due to the location possibly changing)

any ideas people?
 
Code:
Option Compare Database
Option Explicit

'************** Code Start **************
'This code was originally written by Terry Kreft.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code courtesy of
'Terry Kreft

'Some modifications made by Peter De Baets of
'Peter's Software - http://www.peterssoftware.com
'
'FYI: The file open/save dialog module can be found here:
'http://www.mvps.org/access/api/api0001.htm
'
' modified by agpuzon for x64 system
'

#If VBA7 Or Win64 Then

    Private Type BROWSEINFO
        hOwner As LongPtr
        pidlRoot As LongPtr
        pszDisplayName As String
        lpszTitle As String
        ulFlags As Long
        lpfn As LongPtr
        lParam As LongPtr
        iImage As Long
    End Type
    
    Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
            (ByVal pidl As LongPtr, ByVal pszPath As String) As Long
            
    Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
        (lpBrowseInfo As BROWSEINFO) As LongPtr
#Else

    Private Type BROWSEINFO
      hOwner As Long
      pidlRoot As Long
      pszDisplayName As String
      lpszTitle As String
      ulFlags As Long
      lpfn As Long
      lParam As Long
      iImage As Long
    End Type

    Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
                "SHGetPathFromIDListA" (ByVal pidl As Long, _
                ByVal pszPath As String) As Long
                
    Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
                "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
                As Long
            
#End If
Private Const BIF_RETURNONLYFSDIRS = &H1

Sub a_test()
Dim strFolderName As String

strFolderName = BrowseFolder("Please select a folder.")

MsgBox strFolderName

End Sub


Public Function BrowseFolder(szDialogTitle As String) As String
'* This function returns a folder selected in the Windows folder browse common dialog
'* it was modified by Peter De Baets to always return a folder string with a trailing "\"
  Dim X As Long, bi As BROWSEINFO
#If Win64 Or VBA7 Then
  Dim dwIList As LongPtr
#Else
  Dim dwIList As Long
#End If
  Dim szPath As String, wPos As Integer
  Dim strRtn As String
  
    strRtn = ""
  
    With bi
        .hOwner = hWndAccessApp
        .lpszTitle = szDialogTitle
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With
    
    dwIList = SHBrowseForFolder(bi)
    szPath = Space$(512)
    'szPath = String$(512, Chr(0))
    X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
    
    If X Then
        wPos = InStr(szPath, Chr(0))
        strRtn = Left$(szPath, wPos - 1)
    Else
        strRtn = ""
    End If
    
    '* Make sure that the folder is always returned with a backslash at the end
    If Right(strRtn, 1) = "\" Then
    Else
        If IsNull(strRtn) Or strRtn = "" Then
        Else
            strRtn = strRtn & "\"
        End If
    End If
    BrowseFolder = strRtn
End Function
 
Thank you for your prompt response. I have a command button that i have attached the code to but I'm not getting any results. Could you perhaps instruct me on what to do?
 
put the code in a module.

then OnClick event of your button:

private sub button_Click()
dim strPath as string
strPath = BrowseFolder("Select folder")
end sub
 

Users who are viewing this thread

Back
Top Bottom