Option Compare Database
Option Explicit
'Code needed to use the Windows "Open File" and "Save As" Dialog Boxes
'to capture file path for exporting spreadsheets, etc.
'Declare needed functions
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
'Declare OPENFILENAME custom Type
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
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 mstrFileName As String
Private mblnStatus As Boolean
Public Property Let GetName(strName As String)
mstrFileName = strName
End Property
Public Property Get GetName() As String
GetName = mstrFileName
End Property
Public Property Let GetStatus(blnStatus As Boolean)
mblnStatus = blnStatus
End Property
Public Property Get GetStatus() As Boolean
GetStatus = mblnStatus
End Property
'Function needed to call the "Open File" dialog
Public Function OpenFileDialog(lngFormHwnd As Long, lngAppInstance As Long, strInitDir As String, strFileFilter As String) As Long
Dim OpenFile As OPENFILENAME
Dim X As Long
With OpenFile
.lStructSize = Len(OpenFile)
.hwndOwner = lngFormHwnd
.hInstance = lngAppInstance
.lpstrFilter = strFileFilter
.nFilterIndex = 1
.lpstrFile = String(257, 0)
.nMaxFile = Len(OpenFile.lpstrFile) - 1
.lpstrFileTitle = OpenFile.lpstrFile
.nMaxFileTitle = OpenFile.nMaxFile
'.lpstrInitialDir = strInitDir.lpstrTitle = "Open File"
.Flags = 0
End With
X = GetOpenFileName(OpenFile)
If X = 0 Then
mstrFileName = "none"
mblnStatus = False
Else
mstrFileName = Trim(OpenFile.lpstrFile)
mblnStatus = True
End If
End Function
'Function needed to call the "Save As" dialog
Public Function SaveFileDialog(lngFormHwnd As Long, _
lngAppInstance As Long, _
strInitDir As String, _
strFileFilter As String) As Long
Dim SaveFile As OPENFILENAME
Dim X As Long
Dim strFileName As String
If IsMissing(strFileName) Then strFileName = ""
With SaveFile
.lStructSize = Len(SaveFile)
.hwndOwner = lngFormHwnd
.hInstance = lngAppInstance
.lpstrFilter = strFileFilter
.nFilterIndex = 1
.lpstrFile = String(257, 0)
.nMaxFile = Len(SaveFile.lpstrFile) - 1
.lpstrFileTitle = SaveFile.lpstrFile
.nMaxFileTitle = SaveFile.nMaxFile
.lpstrInitialDir = strInitDir
.lpstrTitle = "Export To"
.Flags = 0
.lpstrDefExt = ".xls" 'sets default file extension to Excel, in case user does not type it
End With
X = GetSaveFileName(SaveFile)
If X = 0 Then
mstrFileName = "none"
mblnStatus = False
Else
mstrFileName = Trim(SaveFile.lpstrFile)
mblnStatus = True
End If
End Function
'--- End of Module Code ---
Private Sub ImportRep_Click() 'function that uses open file dialog to get the file path string
Dim lngFormHwnd As Long
Dim lngAppInstance As Long
Dim strInitDir As String
Dim strFileFilter As String
Dim lngResult As Long
Dim strSavePath As String
lngFormHwnd = Me.hwnd
lngAppInstance = Application.hWndAccessApp
strInitDir = "C:\"
strFileFilter = "Text Files (*.csv, *.txt)" & Chr(0) & "*.csv; *.txt" & Chr(0) & "Excel Files (*.xls)" & Chr(0) & "*.xls" & Chr(0)
lngResult = OpenFileDialog(lngFormHwnd, lngAppInstance, strInitDir, strFileFilter)
strSavePath = GetName 'get filepath of selected file
DoCmd.TransferText acImportFixed, "default import specification", "Import", strSavePath 'import selected file
End Sub
