can anyone help me with part of that code (1 Viewer)

nawin

New member
Local time
Today, 10:10
Joined
Jul 17, 2007
Messages
1
I added the bold and red code after the data was imported so this code only work after the data have been imported. I deleted the data and wanted to import, instead because of that part, it deleted the table where it says delete table, I don't know if it's because dcount is not define. This is only so the data can be imported once, but i don't want to go back and forth on adding code after the data was imported, than delete the code when you want to start back from scratch. any help will be gladly appreciated













Option Compare Database
Option Explicit

'--------------------------------------------------------
'Form name: frmLinkMMARSData
'The form allow the user to navigate to find the database
'where the raw data table is locate.
'Allow the user to import data to create tblMMARS.
'--------------------------------------------------------


Private Sub cmdClose_Click()
DoCmd.Close
DoCmd.OpenForm "mainform"
End Sub

Private Sub cmdOpenFile_Click()
On Error GoTo handler

With dialog
.ShowOpen
txtPath.SetFocus
txtPath.Text = .FileName
End With


Cleanup:
Exit Sub

handler:
Select Case Err
Case Err
MsgBox Err.Description
End Select
Resume Cleanup

End Sub


Private Sub cmdLinkData_Click()
On Error GoTo handler

Dim dbPath As String
Dim SourceTable As String
Dim Ret As String
Dim db As Database
Dim tbldef As TableDef
Dim tblDMH As TableDef
Dim Found As Boolean


'make sure fields are entered correctly
If IsNull(Me!txtPath) Or Trim(Me!txtPath) = "" Then
MsgBox "Please use Find Database to locate the file."
txtPath.SetFocus
Exit Sub
ElseIf IsNull(Me!txtMMARSDataTable) Or Trim(Me!txtMMARSDataTable) = "" Then
MsgBox "Please type the name of table to be imported."
txtMMARSDataTable.SetFocus
Exit Sub
End If


dbPath = txtPath 'database path
SourceTable = txtMMARSDataTable 'table name


'Tell computer where to find the database
Set db = DBEngine(0).OpenDatabase(dbPath, False, False, ";pwd=dmh")

Found = False

'check the collection for table name
For Each tbldef In db.TableDefs
If tbldef.Name = SourceTable Then
Found = True
End If
Next

If Not Found Then
MsgBox "The table name was not found. Please check the database location and the spelling of your table name."
Exit Sub
End If


'check current database for dmhMMARSData table
For Each tblDMH In CurrentDb.TableDefs
If tblDMH.Name = "tblCentralExpenseDetail" Then
DoCmd.DeleteObject acTable, "tblCentralExpenseDetail" 'delete table
Exit For 'exit loop
End If
Next

'link table, transfer data, and rename it DMHMMARSData

'''''''''begin asking if the data has been imported, ask the user''''''''''''''''''''''''''''''''''''''
Dim iRet As Integer
If dcount("*", "DMHMMARSData") > 0 Then
iRet = MsgBox("Data has been imported already. Do you want to import again or not?", vbYesNo)

If iRet = vbYes Then
DoCmd.TransferDatabase acLink, "Microsoft Access", dbPath, acTable, SourceTable, "tblCentralExpenseDetail", 0
Else
Exit Sub
End If
End If
''''''''''''''''''''''''''''''''''''''''''''''end asking''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''

'DoCmd.TransferDatabase acLink, "Microsoft Access", dbPath, acTable, SourceTable, "tblCentralExpenseDetail", 0

DoCmd.SetWarnings (False)
DoCmd.OpenQuery "qryNewAppend_1", acViewNormal

'Update Account Types 12,13,1001 (10) = Encumbered 14,15 = Expended
'DoCmd.OpenQuery "qryUpdateAcctType_1", acViewNormal
'DoCmd.OpenQuery "qryUpdateAcctType_2", acViewNormal

'tell user that it is done
Ret = MsgBox("The DMH MMARS data import was successful. Would you like to view the MMARS Data?", vbYesNo, "View DMHMMARSData")
If Ret = vbYes Then
DoCmd.OpenForm "DMHMMARSdata", acFormDS, , , acFormReadOnly
Else
DoCmd.Close acForm, "frmlinkMMARSData"
DoCmd.OpenForm "mainform"
End If

Cleanup:
Exit Sub

handler:
Select Case Err
Case Err
MsgBox Err.Description
End Select
Resume Cleanup

End Sub


Private Sub cmdViewData_Click()
On Error GoTo handler

DoCmd.OpenForm "DMHMMARSData", acFormDS, , , acFormReadOnly

Cleanup:
Exit Sub

handler:
Select Case Err
Case Err
MsgBox Err.Description
End Select
Resume Cleanup


End Sub

Private Sub Detail_Click()

End Sub
 

Users who are viewing this thread

Top Bottom