WineSnob
Not Bright but TENACIOUS
- Local time
- Today, 09:37
- Joined
- Aug 9, 2010
- Messages
- 211
Can you tell me what I need to change to this “very old and reliable code” to select the filename rather than ALL .xls files. This imports ALL .xls files in the folder. I would like to narrow it down one more level and select a specific .xls file to import.
Private Sub cmdBrowse_Click()
Dim fileflags As FileOpenConstants
Dim filefilter As String
Dim sPath As String
'Set the text in the dialog title bar
CDlg1.DialogTitle = "Select File in Folder"
'Set the default file name and filter
CDlg1.DefaultExt = "xls*"
CDlg1.InitDir = "\"
CDlg1.filename = ""
filefilter = "*.xls"
CDlg1.Filter = filefilter
CDlg1.FilterIndex = 0
'Prompt to create the file if it does not exist
'and prompt to overwrite if the file exists
fileflags = cdlOFNCreatePrompt + cdlOFNOverwritePrompt
CDlg1.Flags = fileflags
'Show the Save As common dialog box
CDlg1.ShowOpen
'Return the path and file name selected or
'Return an empty string if the user cancels the dialog
sPath = CDlg1.filename
If sPath <> "" Then
txtImportPath = GetFolder(sPath)
UpdateSettings
End If
End Sub
_________________________________________________________
Function GetFolder(sPath As String) As String
Dim nPos As Integer, nLastPos As Integer
nPos = 0
Do
nLastPos = nPos
nPos = InStr(nLastPos + 1, sPath, "\")
'Debug.Print nPos
Loop Until nPos = 0
GetFolder = Left(sPath, nLastPos - 1)
End Function
_________________________________________________________
Function UpdateSettings()
Dim SQL As String
Dim rst As Recordset
SQL = "SELECT * FROM [Settings] WHERE [ID] = 1"
Set rst = CurrentDb.OpenRecordset(SQL)
With rst
.MoveFirst
.Edit
![Import Path] = Me.txtImportPath
.Update
.Close
End With
End Function
________________________________________________________
Private Sub cmdImport_Click()
Dim sPath As String
Dim stDocName As String
Dim xPath As String
Dim nCount As Integer
Dim sFile As String
Dim sMsg As String
Dim db As DAO.Database
Dim rs As TableDef
sPath = Me.txtImportPath & "\*.xls"
nCount = 0
sFile = Dir(sPath)
While sFile <> ""
nCount = nCount + 1
sFile = Dir
Wend
sMsg = "There are " & nCount & " files to import. " & _
"Do you want to import them now?"
If MsgBox(sMsg, vbQuestion Or vbYesNo, "Import Data Files") = vbYes Then
sFile = Dir(sPath)
While sFile <> ""
ImportStore Me.txtImportPath & "\" & sFile, Len(Me.txtImportPath)
sFile = Dir
there is a bunch of stuff here
End Sub
Private Sub cmdBrowse_Click()
Dim fileflags As FileOpenConstants
Dim filefilter As String
Dim sPath As String
'Set the text in the dialog title bar
CDlg1.DialogTitle = "Select File in Folder"
'Set the default file name and filter
CDlg1.DefaultExt = "xls*"
CDlg1.InitDir = "\"
CDlg1.filename = ""
filefilter = "*.xls"
CDlg1.Filter = filefilter
CDlg1.FilterIndex = 0
'Prompt to create the file if it does not exist
'and prompt to overwrite if the file exists
fileflags = cdlOFNCreatePrompt + cdlOFNOverwritePrompt
CDlg1.Flags = fileflags
'Show the Save As common dialog box
CDlg1.ShowOpen
'Return the path and file name selected or
'Return an empty string if the user cancels the dialog
sPath = CDlg1.filename
If sPath <> "" Then
txtImportPath = GetFolder(sPath)
UpdateSettings
End If
End Sub
_________________________________________________________
Function GetFolder(sPath As String) As String
Dim nPos As Integer, nLastPos As Integer
nPos = 0
Do
nLastPos = nPos
nPos = InStr(nLastPos + 1, sPath, "\")
'Debug.Print nPos
Loop Until nPos = 0
GetFolder = Left(sPath, nLastPos - 1)
End Function
_________________________________________________________
Function UpdateSettings()
Dim SQL As String
Dim rst As Recordset
SQL = "SELECT * FROM [Settings] WHERE [ID] = 1"
Set rst = CurrentDb.OpenRecordset(SQL)
With rst
.MoveFirst
.Edit
![Import Path] = Me.txtImportPath
.Update
.Close
End With
End Function
________________________________________________________
Private Sub cmdImport_Click()
Dim sPath As String
Dim stDocName As String
Dim xPath As String
Dim nCount As Integer
Dim sFile As String
Dim sMsg As String
Dim db As DAO.Database
Dim rs As TableDef
sPath = Me.txtImportPath & "\*.xls"
nCount = 0
sFile = Dir(sPath)
While sFile <> ""
nCount = nCount + 1
sFile = Dir
Wend
sMsg = "There are " & nCount & " files to import. " & _
"Do you want to import them now?"
If MsgBox(sMsg, vbQuestion Or vbYesNo, "Import Data Files") = vbYes Then
sFile = Dir(sPath)
While sFile <> ""
ImportStore Me.txtImportPath & "\" & sFile, Len(Me.txtImportPath)
sFile = Dir
there is a bunch of stuff here
End Sub