samuriacornflak
New member
- Local time
- Today, 02:03
- Joined
- Apr 20, 2005
- Messages
- 9
I've been tinkerig around with this form vba for awhile, about a month I go I download the browes import form from Ghudson..I've been trying to fiddler around with it and work it into something I am doing but it is not working could someone let me know what they see wrong it in....I would really appricate it
--------------------------------------------------------------------------
Option Compare Database
Private Sub bBrowse_Click()
On Error GoTo Err_bBrowse_Click
Dim strFilter As String
Dim lngFlags As Long
Dim varFileName As Variant
Me.tbHidden.SetFocus
' strFilter = "Access (*.mdb)" & vbNullChar & "*.mdb" _
' & vbNullChar & "All Files (*.*)" & vbNullChar & "*.*"
' strFilter = "Access Files (*.mdb)" & vbNullChar & "*.mdb*"
strFilter = "All Files (*.*)" & vbNullChar & "*.*"
lngFlags = tscFNPathMustExist Or tscFNFileMustExist Or tscFNHideReadOnly
varFileName = tsGetFileFromUser( _
fOpenFile:=True, _
strFilter:=strFilter, _
rlngflags:=lngFlags, _
strDialogTitle:="Find File (Select The File And Click The Open Button)")
If IsNull(varFileName) Or varFileName = "" Then
Debug.Print "User pressed 'Cancel'."
Beep
MsgBox "File selection was canceled.", vbInformation
Exit Sub
Else
'Debug.Print varFileName
tbFile = varFileName
End If
Call ParseFileName
Exit_bBrowse_Click:
Exit Sub
Err_bBrowse_Click:
MsgBox Err.Number & " - " & Err.Description
Resume Exit_bBrowse_Click
End Sub
Private Sub bImport_Click()
On Error GoTo Err_bImport_Click
Me.tbHidden.SetFocus
If IsNull(tbFile) Or tbFile = "" Then
MsgBox "Please browse and select a valid file to import.", vbCritical, "Invalid File"
Else
If Dir("C:\Documents and Settings\SMealia\My Documents\smgsnf.txt") <> "" Then
CurrentDb().Execute "DELETE * FROM Oscar"
FileCopy "C:\Documents and Settings\SMealia\My Documents\smgsnf.txt", "C:\Documents and Settings\SMealia\My Documents\smgsnf.txt"
DoCmd.TransferText acImportDelim, , "Oscar", "C:\Documents and Settings\SMealia\My Documents\smgsnf.txt"
MsgBox "For testing purposes the 'Import' button has imported your C:\Winnt\Win.ini file into the tImport table."
Else
MsgBox "Your computer does not have a C:\Winnt\Win.ini file so the import example will not work.", vbInformation
End If
End If
Exit_bImport_Click:
Exit Sub
Err_bImport_Click:
MsgBox Err.Number & " - " & Err.Description
Resume Exit_bImport_Click
End Sub
Private Sub bOpenFile_Click()
On Error GoTo Err_bOpen_Click
Me.tbHidden.SetFocus
If IsNull(tbFile) Or tbFile = "" Then
MsgBox "Please browse and select a valid file to open.", vbCritical, "Invalid File"
Else
OpenFile (tbFile)
End If
Exit_bOpen_Click:
Exit Sub
Err_bOpen_Click:
MsgBox Err.Number & " - " & Err.Description
Resume Exit_bOpen_Click
End Sub
Private Sub Command0_Click()
With DoCmd
.SetWarnings False
'just sql '
.SetWarnings True
End With
MsgBox "Finished"
End Sub
Private Sub Form_open(cancel As Integer)
On Error GoTo Err_Form_Open
DoCmd.Restore
Exit_Form_Open:
Exit Sub
Err_Form_Open:
MsgBox Err.Number & " - " & Err.Description
Resume Exit_Form_Open
End Sub
Private Function ParseFileName()
On Error GoTo Err_ParseFileName
Dim sFullName As String
Dim sFilePathOnly As String
Dim sDrive As String
Dim sPath As String
Dim sLocation As String
Dim sFileName As String
sFullName = tbFile.Value
' Find the final "\" in the path.
sPath = sFullName
Do While Right$(sPath, 1) <> "\"
sPath = Left$(sPath, Len(sPath) - 1)
Loop
' Find the Drive.
sDrive = Left$(sFullName, InStr(sFullName, ":") + 1)
'tbDrive = sDrive
' Find the Location.
sLocation = Mid$(sPath, Len(sDrive) - 2)
'tbLocation = sLocation
' Find the Path.
sPath = Mid$(sPath, Len(sDrive) + 1)
'tbPath = sPath
' Find the file name.
sFileName = Mid$(sFullName, Len(sPath) + 4)
tbFileName = sFileName
Exit_ParseFileName:
Exit Function
Err_ParseFileName:
MsgBox Err.Number & " - " & Err.Description
Resume Exit_ParseFileName
End Function
End Function
--------------------------------------------------------------------------
Option Compare Database
Private Sub bBrowse_Click()
On Error GoTo Err_bBrowse_Click
Dim strFilter As String
Dim lngFlags As Long
Dim varFileName As Variant
Me.tbHidden.SetFocus
' strFilter = "Access (*.mdb)" & vbNullChar & "*.mdb" _
' & vbNullChar & "All Files (*.*)" & vbNullChar & "*.*"
' strFilter = "Access Files (*.mdb)" & vbNullChar & "*.mdb*"
strFilter = "All Files (*.*)" & vbNullChar & "*.*"
lngFlags = tscFNPathMustExist Or tscFNFileMustExist Or tscFNHideReadOnly
varFileName = tsGetFileFromUser( _
fOpenFile:=True, _
strFilter:=strFilter, _
rlngflags:=lngFlags, _
strDialogTitle:="Find File (Select The File And Click The Open Button)")
If IsNull(varFileName) Or varFileName = "" Then
Debug.Print "User pressed 'Cancel'."
Beep
MsgBox "File selection was canceled.", vbInformation
Exit Sub
Else
'Debug.Print varFileName
tbFile = varFileName
End If
Call ParseFileName
Exit_bBrowse_Click:
Exit Sub
Err_bBrowse_Click:
MsgBox Err.Number & " - " & Err.Description
Resume Exit_bBrowse_Click
End Sub
Private Sub bImport_Click()
On Error GoTo Err_bImport_Click
Me.tbHidden.SetFocus
If IsNull(tbFile) Or tbFile = "" Then
MsgBox "Please browse and select a valid file to import.", vbCritical, "Invalid File"
Else
If Dir("C:\Documents and Settings\SMealia\My Documents\smgsnf.txt") <> "" Then
CurrentDb().Execute "DELETE * FROM Oscar"
FileCopy "C:\Documents and Settings\SMealia\My Documents\smgsnf.txt", "C:\Documents and Settings\SMealia\My Documents\smgsnf.txt"
DoCmd.TransferText acImportDelim, , "Oscar", "C:\Documents and Settings\SMealia\My Documents\smgsnf.txt"
MsgBox "For testing purposes the 'Import' button has imported your C:\Winnt\Win.ini file into the tImport table."
Else
MsgBox "Your computer does not have a C:\Winnt\Win.ini file so the import example will not work.", vbInformation
End If
End If
Exit_bImport_Click:
Exit Sub
Err_bImport_Click:
MsgBox Err.Number & " - " & Err.Description
Resume Exit_bImport_Click
End Sub
Private Sub bOpenFile_Click()
On Error GoTo Err_bOpen_Click
Me.tbHidden.SetFocus
If IsNull(tbFile) Or tbFile = "" Then
MsgBox "Please browse and select a valid file to open.", vbCritical, "Invalid File"
Else
OpenFile (tbFile)
End If
Exit_bOpen_Click:
Exit Sub
Err_bOpen_Click:
MsgBox Err.Number & " - " & Err.Description
Resume Exit_bOpen_Click
End Sub
Private Sub Command0_Click()
With DoCmd
.SetWarnings False
'just sql '
.SetWarnings True
End With
MsgBox "Finished"
End Sub
Private Sub Form_open(cancel As Integer)
On Error GoTo Err_Form_Open
DoCmd.Restore
Exit_Form_Open:
Exit Sub
Err_Form_Open:
MsgBox Err.Number & " - " & Err.Description
Resume Exit_Form_Open
End Sub
Private Function ParseFileName()
On Error GoTo Err_ParseFileName
Dim sFullName As String
Dim sFilePathOnly As String
Dim sDrive As String
Dim sPath As String
Dim sLocation As String
Dim sFileName As String
sFullName = tbFile.Value
' Find the final "\" in the path.
sPath = sFullName
Do While Right$(sPath, 1) <> "\"
sPath = Left$(sPath, Len(sPath) - 1)
Loop
' Find the Drive.
sDrive = Left$(sFullName, InStr(sFullName, ":") + 1)
'tbDrive = sDrive
' Find the Location.
sLocation = Mid$(sPath, Len(sDrive) - 2)
'tbLocation = sLocation
' Find the Path.
sPath = Mid$(sPath, Len(sDrive) + 1)
'tbPath = sPath
' Find the file name.
sFileName = Mid$(sFullName, Len(sPath) + 4)
tbFileName = sFileName
Exit_ParseFileName:
Exit Function
Err_ParseFileName:
MsgBox Err.Number & " - " & Err.Description
Resume Exit_ParseFileName
End Function
End Function