Modify code to import one .xls file

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
 

Users who are viewing this thread

Back
Top Bottom