Copy the code below into a new module - hopefully should be self explanatory - if not post again!
Option Explicit
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
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
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.
' Examples from Chapter 12
Private Type OPENFILENAME
lngStructSize As Long ' Size of structure
hWndOwner As Long ' Owner window handle
hInstance As Long ' Template instance handle
strfilter As String ' Filter string
strCustomFilter As String ' Selected filter string
intMaxCustFilter As Long ' Len(strCustomFilter)
intFilterIndex As Long ' Index of filter string
strFile As String ' Selected filename & path
intMaxFile As Long ' Len(strFile)
strFileTitle As String ' Selected filename
intMaxFileTitle As Long ' Len(strFileTitle)
strInitialDir As String ' Directory name
strTitle As String ' Dialog title
lngFlags As Long ' Dialog flags
intFileOffset As Integer ' Offset of filename
intFileExtension As Integer ' Offset of file extension
strDefExt As String ' Default file extension
lngCustData As Long ' Custom data for hook
lngfnHook As Long ' LP to hook function
strTemplateName As String ' Dialog template name
End Type
Declare Function GetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (ofn As OPENFILENAME) As Boolean
Declare Function GetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" (ofn As OPENFILENAME) As Boolean
' Open/Save dialog flags
Global Const OFN_READONLY = &H1
Global Const OFN_OVERWRITEPROMPT = &H2
Global Const OFN_HIDEREADONLY = &H4
Global Const OFN_NOCHANGEDIR = &H8
Global Const OFN_SHOWHELP = &H10
Global Const OFN_NOVALIDATE = &H100
Global Const OFN_ALLOWMULTISELECT = &H200
Global Const OFN_EXTENSIONDIFFERENT = &H400
Global Const OFN_PATHMUSTEXIST = &H800
Global Const OFN_FILEMUSTEXIST = &H1000
Global Const OFN_CREATEPROMPT = &H2000
Global Const OFN_SHAREAWARE = &H4000
Global Const OFN_NOREADONLYRETURN = &H8000
Global Const OFN_NOTESTFILECREATE = &H10000
Global Const OFN_NONETWORKBUTTON = &H20000
Global Const OFN_NOLONGNAMES = &H40000
' Flags for hook functions and dialog templates
'Global Const OFN_ENABLEHOOK = &H20
'Global Const OFN_ENABLETEMPLATE = &H40
'Global Const OFN_ENABLETEMPLATEHANDLE = &H80
' Windows 95 flags
Global Const OFN_EXPLORER = &H80000
Global Const OFN_NODEREFERENCELINKS = &H100000
Global Const OFN_LONGNAMES = &H200000
' Custom flag combinations
Global Const dhOFN_OPENEXISTING = OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY
Global Const dhOFN_SAVENEW = OFN_PATHMUSTEXIST Or OFN_OVERWRITEPROMPT Or OFN_HIDEREADONLY
Global Const dhOFN_SAVENEWPATH = OFN_OVERWRITEPROMPT Or OFN_HIDEREADONLY
Private Declare Function GetActiveWindow Lib "user32" () As Long
Function dhFileDialog( _
Optional strInitDir As String, _
Optional strfilter As String = _
"All files (*.*)" & vbNullChar & "*.*" & _
vbNullChar & vbNullChar, _
Optional intFilterIndex As Integer = 1, _
Optional strDefaultExt As String = "", _
Optional strFileName As String = "", _
Optional strDialogTitle As String = "Open File", _
Optional hwnd As Long = -1, _
Optional fOpenFile As Boolean = True, _
Optional ByRef lngFlags As Long = _
dhOFN_OPENEXISTING) As Variant
' Wrapper function for the GetOpenFileName API function.
' Displays the common open/save as dialog and returns
' the file(s) selected by the user.
' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.
' In:
' strInitDir (Optional)
' Inital directory.
' strFilter (Optional)
' File filter as null delimited/double-null
' terminated string.
' intFilterIndex (Optional, default = 1)
' Initial filter index.
' strDefaultExt (Optional)
' Default file extension if none specified.
' strFilename (Optional)
' Initial file name for dialog.
' strDialogTitle (Optional, default = "Open File"

' Dialog title.
' hwnd (Optional, default = -1)
' Handle of dialog owner window.
' fOpenFile (Optional, default = True)
' If True, displays Open dialog, if False,
' displays Save As dialog.
' lngFlags (Optional)
' Flags for API function (see declarations section).
' Out:
' lngFlags
' Returns flags set by the API function after closing
' the dialog.
' Return Value:
' Name of the file or files chosen by the user.
' Note:
' If you allow multi-select, returned string will
' be the directory name followed by a space-delimited
' list of files.
' Example:
' strFile = dhFileDialog(strFilter:="All files" & _
' vbNullChar & "*.*" & vbNullChar & vbNullChar)
Dim ofn As OPENFILENAME
Dim strFileTitle As String
Dim fResult As Boolean
' Fill in some of the missing arrguments
If strInitDir = "" Then
strInitDir = CurDir
End If
If hwnd = -1 Then
hwnd = GetActiveWindow()
End If
' Set up the return buffers
strFileName = strFileName & String(1000 - Len(strFileName), 0)
strFileTitle = String(1000, 0)
' Fill in the OPENFILENAME structure members
With ofn
.lngStructSize = Len(ofn)
.hWndOwner = hwnd
.strfilter = strfilter
.intFilterIndex = intFilterIndex
.strFile = strFileName
.intMaxFile = Len(strFileName)
.strFileTitle = strFileTitle
.intMaxFileTitle = Len(strFileTitle)
.strTitle = strDialogTitle
.lngFlags = lngFlags
.strDefExt = strDefaultExt
.strInitialDir = strInitDir
.hInstance = 0
.strCustomFilter = String(255, 0)
.intMaxCustFilter = 255
.lngfnHook = 0
End With
' Call the right function
If fOpenFile Then
fResult = GetOpenFileName(ofn)
Else
fResult = GetSaveFileName(ofn)
End If
' If successful, return the filename,
' otherwise return Null
If fResult Then
' Return any flags to the calling procedure
lngFlags = ofn.lngFlags
' Return the result
If (ofn.lngFlags And OFN_ALLOWMULTISELECT) = 0 Then
dhFileDialog = dhTrimNull(ofn.strFile)
Else
dhFileDialog = ofn.strFile
End If
Else
dhFileDialog = Null
End If
End Function
Sub dhTestDialog()
' Test function for dhFileDialog function.
' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.
' In:
' n/a
' Out:
' n/a
' Example:
' Call dhTestDialog()
' Open a file in the current directory
Debug.Print dhFileDialog()
' Open multiple files in the Windows directory
Debug.Print dhFileDialog(strInitDir:="C:\WINDOWS", _
lngFlags:=dhOFN_OPENEXISTING Or OFN_ALLOWMULTISELECT _
Or OFN_EXPLORER)
' Save a file as a text file
Debug.Print dhFileDialog(strfilter:="Text Files" & _
vbNullChar & "*.txt" & vbNullChar & vbNullChar, _
strDialogTitle:="Save As", lngFlags:=dhOFN_SAVENEW, _
fOpenFile:=False)
End Sub
Function GetTextFileName(ByVal strTitle As String) As String
'calls common dialog for test file with title strtitle
Dim strInitDir As String
On Error GoTo ProcError
strInitDir = GetDrive("Zur GGL\09 Testing\01 UnitTest\Testing Input Output Files & Raw Data"

& "\"
GetTextFileName = nz(dhFileDialog(strInitDir, _
"Text Files *.txt", _
1, _
"txt", , _
strTitle, , , _
OFN_FILEMUSTEXIST + OFN_PATHMUSTEXIST), ""

ProcExit:
Exit Function
ProcError:
MsgBox Error(Err)
Resume ProcExit
End Function
Function SaveTextFile(ByVal strTitle As String, strFileName As String) As String
'calls common dialog for test file with title strtitle
Dim strInitDir As String
On Error GoTo ProcError
strInitDir = GetThisPath("export"

SaveTextFile = nz(dhFileDialog(strInitDir, _
"Text Files *.txt", _
1, _
"txt", _
strFileName, _
strTitle, , _
False, _
OFN_PATHMUSTEXIST), ""

ProcExit:
Exit Function
ProcError:
MsgBox Error(Err)
Resume ProcExit
End Function
Function GetAccessDBName(ByVal strTitle As String) As String
'calls common dialog for test file with title strtitle
Dim strInitDir As String
Dim strfilter As String
On Error GoTo ProcError
strfilter = "Access files" & vbNullChar & "*.mdb" & vbNullChar & vbNullChar
strInitDir = ThisWorkbook.Path
GetAccessDBName = nz(dhFileDialog(strInitDir, _
strfilter, _
0, _
"mdb", , _
strTitle, , , _
OFN_FILEMUSTEXIST + OFN_PATHMUSTEXIST), ""

ProcExit:
Exit Function
ProcError:
MsgBox Error(Err)
Resume ProcExit
End Function
Public Function GetMultipleFiles(ByVal strExtension As String, strTitle As String) As Variant
'Purpose: Get list of files of a single type to open from user
'Inputs: strExtension - filetype required
' strTitle - dialog title
'Output: variant array of full path file names selected by user
' or Null if none selected
Dim varFiles As Variant 'variant array to hold result of dialog
Dim strfilter As String 'for use in dialog
Dim lngFlags As Long 'ditto
Dim intFileCount As Integer 'how many files were selected
Dim strArrFiles() As String 'to work with file array
Dim intI As Integer 'counter
Dim strDirectory As String 'to determine full path
Dim intPosStart As Integer 'counters in parsing of file name string
Dim intPosEnd As Integer
'set constants
lngFlags = dhOFN_OPENEXISTING Or OFN_ALLOWMULTISELECT Or OFN_EXPLORER
strfilter = strExtension & " Files (*." & strExtension & "

" & vbNullChar & "*." & _
strExtension & vbNullChar & vbNullChar
'get list of files
varFiles = dhFileDialog(strDialogTitle:=strTitle, strfilter:=strfilter, lngFlags:=lngFlags)
'if no file sselected then return null and exit
If IsNull(varFiles) = True Then
GetMultipleFiles = Null
'otherwise
Else
'dhFileDialog returns
' 1. Directory
' 2. File names
'separated by vbnull chars
'repalce nulls with spaces and trim
'varFiles = dhReplaceAll(varFiles, vbNullChar, " "

varFiles = drRightTrimNull(varFiles)
varFiles = varFiles & vbNullChar
'determine number of files we are dealing with
intFileCount = dhCountIn(CStr(varFiles), strExtension)
'if just 1 file then simple assignment
If intFileCount = 1 Then
ReDim strArrFiles(0)
strArrFiles(0) = drRightTrimNull(Trim(varFiles))
Else
'redim an array of filenames
ReDim strArrFiles(intFileCount - 1)
'first get the directory (assume first vbnullchar)
intPosStart = InStr(1, varFiles, vbNullChar)
strDirectory = Left(varFiles, intPosStart - 1) & "\"
'now get file names
For intI = 1 To intFileCount
intPosEnd = InStr(intPosStart + 1, varFiles, vbNullChar)
strArrFiles(intI - 1) = drRightTrimNull(Trim(strDirectory & _
Mid(varFiles, intPosStart + 1, intPosEnd - intPosStart - 1)))
intPosStart = intPosEnd
Next intI
End If
GetMultipleFiles = strArrFiles
End If
End Function
Function GetCSVFileName(ByVal strTitle As String) As String
'calls common dialog for test file with title strtitle
Dim strInitDir As String
Dim strfilter As String
strfilter = "csv files" & vbNullChar & "*.csv" & vbNullChar & vbNullChar
On Error GoTo ProcError
If Len(gstrDir) > 0 Then
strInitDir = gstrDir
Else
strInitDir = ThisWorkbook.Path & "\"
End If
GetCSVFileName = nz(dhFileDialog(strInitDir, _
strfilter, _
1, _
".csv", , _
strTitle, , , _
OFN_FILEMUSTEXIST + OFN_PATHMUSTEXIST), ""

ProcExit:
Exit Function
ProcError:
MsgBox Error(Err)
Resume ProcExit
End Function
Function SaveCSVFileName(ByVal strTitle As String, ByVal strInitDir As String, ByVal strFileName As String) As String
'calls common dialog for test file with title strtitle
Dim strfilter As String
strfilter = "csv files" & vbNullChar & "*.csv" & vbNullChar & vbNullChar
On Error GoTo ProcError
SaveCSVFileName = nz(dhFileDialog(strInitDir, _
strfilter, _
1, _
".csv", strFileName, _
strTitle, , False, _
dhOFN_SAVENEW), ""

ProcExit:
Exit Function
ProcError:
MsgBox Error(Err)
Resume ProcExit
End Function
Function GetDirectory(strTitle As String)
'Opens a Treeview control that displays the directories in a computer
Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo
szTitle = strTitle
With tBrowseInfo
'.hWndOwner = Me.hwnd
.lpszTitle = lstrcat(szTitle, ""

.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
Public Function GetDrive(ByVal strPartPath As String) As String
Dim strPath As String
Dim hFileNew As Long 'Handle on new file
Dim varDrive As Variant
Dim intI As Integer
'get file handles
hFileNew = FreeFile
varDrive = Array("d", "e", "f", "g", "h", "i", "j", "k", "l", "m", _
"n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z", "c"

GetDrive = ""
For intI = 0 To UBound(varDrive)
On Error Resume Next
strPath = varDrive(intI) & ":\" & strPartPath & "\" & "zzTest.txt"
'open up files
Open strPath For Output As hFileNew
If Err = 0 Then
Close hFileNew
Kill strPath
GetDrive = varDrive(intI) & ":\" & strPartPath
Exit Function
End If
Next intI
End Function
Public Function GetThisPath(ByVal strType As String)
'returns path from full path / name
Dim strFullPath As String
Dim intPos As String
Dim intI As Integer
Dim b1done As Boolean
GetThisPath = ThisWorkbook.Path & "\" & strType
End Function