Getting Access OBject

[drek01]

i have a form in Access, and i want to browse the table when i click on that tab. i already have a dialog box, where i can add table name and can import to my database. however i want the dialog box to browse the access tables( not files). i try to do it but is not working.
Any help will be appreciated.

Here is the code:

'**************************************************
'** CIMS
'**
'** MODULE NAME : PLANNING/ FIRST DAY LETTER
'** SCREEN NAME :
'** PURPOSE : Menu Function
'** CALLED FROM : Main Form
'** CREATION DATE :
'** CREATED BY :
'** MODIFICATION
'** - - - - - - - - - - - - - - - - - - - - - - - -
'** MODIFIED BY DATE DESCRIPTION
'** - - - - - - - - - - - - - - - - - - - - - - - -
'**
'** N.DEVI 07-MAR-05 CHANGES DONE TO IMPORT LOAN DATA AS PER ADP VERSION
'**
'** - - - - - - - - - - - - - - - - - - - - - - - -
'**************************************************
Option Compare Database
Option Explicit
Dim sStr As String
Dim strTable As String


Private Sub cmdAddToTblMaster_Click()

On Error GoTo Error_cmdAddToTblMaster_Click

DoCmd.Openform "frmAddToTblMaster"

Exit_cmdAddToTblMaster_Click:
Exit Sub
Error_cmdAddToTblMaster_Click:
MsgBox Err.Number & " " & Err.Description, vbCritical, "CIMS"

End Sub

Private Sub cmdfirstday_Click()
On Error GoTo Err_cmdfirstday_Click

DoCmd.Openform "frmFirstdayletter"
Me.Form.Visible = False


Exit_cmdfirstday_Click:
Exit Sub

Err_cmdfirstday_Click:
MsgBox Err.Description, vbCritical, "CIMS"
Resume Exit_cmdfirstday_Click

End Sub

Private Sub cmdImport_Click()
Dim adoCmd As ADODB.Command
Dim invalid As Integer
On Error GoTo Err_cmdImport_Click
strTable = InputBox("Enter table name", "ImportTable")

If Trim(strTable) <> "" Then
Set adoCmd = New ADODB.Command
With adoCmd
.ActiveConnection = CurrentProject.Connection
.CommandText = "SPR_QRYLOADDATA"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("@TABLENAME", adVarChar, adParamInput, 50, Trim(strTable))
.Execute
End With
MsgBox "Import Successful", vbInformation, "CIMS"
End If
If Trim(strTable) <> "" And invalid <> 1 Then
DoCmd.DeleteObject acTable, "" & Trim(strTable) & ""
Exit_cmdImport_Click:

End If
Set adoCmd = Nothing
Exit Sub
Err_cmdImport_Click:
If Err.Number = -2147217873 Then
MsgBox "Cannot import duplicate records. Check the data and try again.", vbCritical, "CIMS"
Else
If Err.Number = -2147217865 Then
MsgBox "Enter valid table name", vbCritical, "CIMS"
invalid = 1
GoTo Exit_cmdImport_Click
Else
MsgBox Err.Number & " " & Err.Description, vbCritical, "CIMS"
End If
End If
Resume Exit_cmdImport_Click

End Sub


Private Sub cmdmainmenu_Click()
On Error GoTo Err_cmdmainmenu_Click

DoCmd.Openform "frmMainMenu"
Me.Visible = False

Exit_cmdmainmenu_Click:
Exit Sub

Err_cmdmainmenu_Click:
MsgBox Err.Description, vbCritical, "CIMS"
Resume Exit_cmdmainmenu_Click

End Sub

Private Sub cmdreadlist_Click()
Dim sSQL As String
Dim adRS As ADODB.Recordset
On Error GoTo Err_cmdreadlist_Click

If (IsNull([Forms]![frmMainMenu]![cmbasofdate])) Or (IsNull([Forms]![frmMainMenu]![cmbexamname])) Then
MsgBox "To prepare ReadList, Selecting ExamName and ExamasofDate is Mandatory.", vbInformation, "CIMS"
GoTo Exit_cmdreadlist_Click
Else
sSQL = " SELECT tblExaminations.ExamAsOfDate,Sum((tblmaster.loans)+
(tblmaster.commitments)+(tblmaster.lcs)" & _
" +(tblmaster.tradefinance)-(tblmaster.YtdSpecificReserve)) AS TotalExposure,tblExaminations.ExamYear," & _
" tblExaminations.ExamName FROM tblExaminations " & _
" INNER JOIN tblMaster ON (tblExaminations.ExamName = tblMaster.OrgUnit) AND" & _
" (tblExaminations.ExamAsOfDate = tblMaster.yymmdd) GROUP BY tblExaminations.ExamAsOfDate," & _
" tblExaminations.ExamYear, tblExaminations.ExamName " & _
" HAVING (((tblExaminations.ExamAsOfDate)='" & Form_frmMainMenu.cmbasofdate.Value & "') " & _
" AND ((tblExaminations.ExamName)='" & Form_frmMainMenu.cmbexamname.Value & "'))"

Set adRS = New ADODB.Recordset
adRS.Open sSQL, CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
If adRS.EOF Then
MsgBox "There is no data available for the exam selected." & vbCrLf, vbInformation, "CIMS"
GoTo Exit_cmdreadlist_Click
End If
End If

DoCmd.Openform "frmReadList"
Me.Form.Visible = False


Exit_cmdreadlist_Click:
Exit Sub

Err_cmdreadlist_Click:
MsgBox Err.Description, vbCritical, "CIMS"
Resume Exit_cmdreadlist_Click

End Sub
Private Sub cmdresearch_Click()
On Error GoTo Err_cmdresearch_Click

DoCmd.Openform "frmResearch"

Exit_cmdresearch_Click:
Exit Sub

Err_cmdresearch_Click:
MsgBox Err.Description, vbCritical, "CIMS"
Resume Exit_cmdresearch_Click

End Sub


Private Sub Form_Activate()
DoCmd.Maximize
End Sub

Private Sub Form_Load()
Dim bflag As Boolean
bflag = bUserPrivileges(Me.Form)
If bflag = False Then
MsgBox "You don't have enough privileges to access this form", vbInformation, "CIMS"
DoCmd.Openform "frmMainMenu"
DoCmd.close
End If
DoCmd.Maximize
End Sub



/// any help would be appreciated

 

[drek01]

// this is the main code for importing table


Private Sub cmdImport_Click()
Dim adoCmd As ADODB.Command
Dim invalid As Integer
On Error GoTo Err_cmdImport_Click
strTable = InputBox("Enter table name", "ImportTable")

If Trim(strTable) <> "" Then
Set adoCmd = New ADODB.Command
With adoCmd
.ActiveConnection = CurrentProject.Connection
.CommandText = "SPR_QRYLOADDATA"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("@TABLENAME", adVarChar, adParamInput, 50, Trim(strTable))
.Execute
End With
MsgBox "Import Successful", vbInformation, "CIMS"
End If
If Trim(strTable) <> "" And invalid <> 1 Then
DoCmd.DeleteObject acTable, "" & Trim(strTable) & ""
Exit_cmdImport_Click:

End If
Set adoCmd = Nothing
Exit Sub
Err_cmdImport_Click:
If Err.Number = -2147217873 Then
MsgBox "Cannot import duplicate records. Check the data and try again.", vbCritical, "CIMS"
Else
If Err.Number = -2147217865 Then
MsgBox "Enter valid table name", vbCritical, "CIMS"
invalid = 1
GoTo Exit_cmdImport_Click
Else
MsgBox Err.Number & " " & Err.Description, vbCritical, "CIMS"
End If
End If
Resume Exit_cmdImport_Click

End Sub