By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
428,978 Members | 1,492 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 428,978 IT Pros & Developers. It's quick & easy.

Part 2: Macros/VBA created in Access 2003 not working in Access 2013

P: 12
ADezii and zmbd,

I have one other question. There seems to be some other code which possibly should reflect the new DAO code. the following does not allow forms to open any longer and files were not moved. I believe the issue is showing the additional string path and view

Expand|Select|Wrap|Line Numbers
  1.  
  2.     Private Sub cmdDETAIL_Click()
  3. If IsNull([prmEmpNo]) Then
  4.     MsgBox ("No employee selected.")
  5.     [prmEmpNo].SetFocus
  6.     Exit Sub
  7. End If
  8. ProjectCount = NoOfProjects
  9. If ProjectCount <> 0 Then
  10.     Forms![fPREPROJECT]![fProjectData].SetFocus
  11.     ProjectCount = NoOfProjects
  12. Else
  13.     MsgBox ("Selection has no records.")
  14.     Exit Sub
  15. End If
  16. Select Case prmProjectGroup
  17.     Case "Complaints"
  18.         If ProjectCount <> 0 Then DoCmd.OpenForm "fComplain01", acNormal, , , acFormEdit
  19.     Case "Lab"
  20.         If ProjectCount <> 0 Then DoCmd.OpenForm "fComplain01", acNormal, , , acFormEdit
  21.     Case "ASBESTOS-INSP"
  22.         If ProjectCount <> 0 Then DoCmd.OpenForm "fAsbInsp01", acNormal, , , acFormEdit
  23.     Case "Inspect-PERM"
  24.         If ProjectCount <> 0 Then DoCmd.OpenForm "fFacInsp01", acNormal, , , acFormEdit
  25.     Case "Enforcement Cases"
  26.         If ProjectCount <> 0 Then DoCmd.OpenForm "fEnforce01", acNormal, , , acFormEdit
  27.     Case "Projects"
  28.         If ProjectCount <> 0 Then DoCmd.OpenForm "fProject01", acNormal, , , acFormEdit
  29.     Case "Permits"
  30.         If ProjectCount <> 0 Then DoCmd.OpenForm "fPermRev01", acNormal, , , acFormEdit
  31.     Case "Training"
  32.         If ProjectCount <> 0 Then DoCmd.OpenForm "fTraining01", acNormal, , , acFormEdit
  33.     Case Else
  34.         MsgBox ("Type of Project selected does not have detail records.")
  35.         Exit Sub
  36. End Select
  37. End Sub
  38.  
  39. Private Sub cmdExit_Click()
  40. DoCmd.Echo False
  41. Me.Visible = False
  42. If (SysCmd(acSysCmdGetObjectState, A_FORM, "fAQSplashForm") = 0) Then
  43.   DoCmd.OpenForm "fAQSplashForm"
  44. End If
  45. DoCmd.Echo True
  46. End Sub
  47.  
  48. Private Sub cmdHELP_Click()
  49. Call NavigHelp
  50. End Sub
  51.  
  52.  
  53. Private Sub cmdMemo_Click()
  54.  
  55. If [Forms]![fPREPROJECT]![fProjectData].Form.CurrentRecord <> 0 Then
  56.     glbProjID = [Forms]![fPREPROJECT]![fProjectData].Form![ipProjID]
  57.     [Forms]![fPREPROJECT]![FormLink1] = [Forms]![fPREPROJECT]![fProjectData].Form![ipProjID]
  58.     DoCmd.OpenForm "fProjMemoPopup"
  59. End If
  60.  
  61.  
  62. End Sub
  63.  
  64.  
  65.  
  66. Private Sub Form_Activate()
  67. 'Me![fProjectData].SetFocus
  68. 'Me![fProjectData].Form![ipProjID].SetFocus
  69.  '           .SelStart = intWhere - 1
  70. '            .SelLength = Len(strSearch
  71. End Sub
  72.  
  73. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  74. If KeyCode <> vbKeyF6 Then Exit Sub
  75. KeyCode = 0
  76. If (SysCmd(acSysCmdGetObjectState, A_FORM, "fAsbFac01") <> 0) Then
  77.     Forms![fAsbFac01].SetFocus
  78. ElseIf (SysCmd(acSysCmdGetObjectState, A_FORM, "fFacDetail01") <> 0) Then
  79.     Forms![fFacDetail01].SetFocus
  80. End If
  81.  
  82. End Sub
  83.  
  84. Private Sub Form_Open(Cancel As Integer)
  85. Dim db As DAO.Database
  86. Set db = CurrentDb()
  87. 'load the Rowsource for [prmEmpNo]
  88. 'code below performs a query and loads information
  89. 'from the EMPLOYEE table into the Rowsource
  90. Dim EmpInfo As DAO.Recordset
  91. Dim i As Integer
  92. Dim qte
  93. qte = Chr(34)
  94. Dim prm As Parameter
  95. Dim QD As DAO.QueryDef
  96.     Set QD = db.QueryDefs("qCmbEmpInfo2")
  97. For i = 0 To QD.Parameters.Count - 1
  98.     Set prm = QD.Parameters(i)
  99.     prm.Value = Eval(prm.Name)
  100. Next i
  101. Set EmpInfo = QD.OpenRecordset(dbOpenDynaset)
  102. EmpInfo.MoveFirst
  103. Do Until EmpInfo.EOF
  104.     [prmEmpNo].RowSource = [prmEmpNo].RowSource & qte & EmpInfo![EmpInfo] & qte & ";" & qte & EmpInfo![Empl_No] & qte & ";"
  105. EmpInfo.MoveNext
  106. Loop
  107. EmpInfo.Close
  108. 'this adds an additional entriy at the beginning of Rowsource
  109. [prmEmpNo].RowSource = qte & "AllActive" & qte & ";" & qte & "Actv" & qte & ";" & [prmEmpNo].RowSource
  110. 'this adds additional entries to the end of Rowsource
  111. [prmEmpNo].RowSource = [prmEmpNo].RowSource & qte & "TOXICS" & qte & ";" & qte & "tox" & qte & ";"
  112. [prmEmpNo].RowSource = [prmEmpNo].RowSource & qte & "STATIONARY SOURCE" & qte & ";" & qte & "cmp" & qte & ";"
  113. [prmEmpNo].RowSource = [prmEmpNo].RowSource & qte & "AllEmployees" & qte & ";" & qte & "AllEmployees" & qte & ";"
  114. 'sets values of startup parameter fields
  115. Forms![fPREPROJECT]![prmProjectGroup] = "AllProjects"
  116. Forms![fPREPROJECT]![prmOpenClosed] = 2
  117. Forms![fPREPROJECT]![prmEmpNo] = "Actv"
  118. DoCmd.Maximize
  119. Me![fProjectData].SetFocus
  120.  
  121. End Sub
  122.  
  123.  
  124.  
  125. Private Sub grpOpenClosed_Click()
  126. Call ResetParms
  127. End Sub
  128.  
  129.  
  130.  
  131. Public Function NoOfProjects()
  132. NoOfProjects = DCount("*", "qProjectData")
  133. End Function
  134.  
  135. Private Sub Opt1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  136. Call RedoSort(1)
  137. 'ME: added September 10, 2008
  138. Call RedoSort(1)
  139.  
  140. End Sub
  141.  
  142. Private Function RedoSort(OptNo As Integer)
  143. If Me.[grpOpenClosed] = OptNo Then
  144.     Forms![fPREPROJECT]![fProjectData].Form.OrderBy = "[SortDate],  [Due Date], [Project Description]"
  145. End If
  146. 'ME:  09/03/2008:  added the following for the Plan Date sorting-this is a test
  147. If OptNo = 5 Then
  148.     Forms![fPREPROJECT]![fProjectData].Form.OrderBy = "[SortDate], [Plan Date], [Project Description]"
  149. End If
  150. End Function
  151.  
  152. Private Sub Opt2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  153. Call RedoSort(2)
  154. 'ME: added September 10, 2008
  155. Call RedoSort(2)
  156. End Sub
  157.  
  158.  
  159.  
  160. Private Sub Opt3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  161. Call RedoSort(3)
  162. 'ME: added September 10, 2008
  163. Call RedoSort(3)
  164. End Sub
  165.  
  166.  
  167. Private Sub Opt4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  168. Call RedoSort(4)
  169. 'ME: added September 10, 2008
  170. Call RedoSort(4)
  171. End Sub
  172.  
  173. Public Function ResetParms()
  174. Call qProjectDataGen(Forms![fPREPROJECT], Forms![fPREPROJECT]![fProjectData].Form)
  175. [Forms]![fPREPROJECT]![fProjectData].Requery
  176. If [Forms]![fPREPROJECT]![fProjectData].[Form].[CurrentRecord] <> 0 Then
  177.     Me![fProjectData].SetFocus
  178.     Me![fProjectData].Form![ipProjID].SetFocus
  179. End If
  180. End Function
  181.  
  182. Private Sub Opt5_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  183. Call RedoSort(5)
  184. 'ME: added September 10, 2008
  185. Call RedoSort(5)
  186. End Sub
  187.  
  188. Private Sub prmEmpNo_Click()
  189. Call ResetParms
  190.  
  191. End Sub
  192.  
  193. Private Sub prmProjectGroup_Click()
  194. Call ResetParms
  195.  
  196. End Sub
  197.  
  198.  
The OpenForm commands are in lines 16-37 of the code sent.

(Related thread: Macros/VBA created in Access 2003 not working in Access 2013 )
Sep 14 '16 #1
Share this Question
Share on Google+
1 Reply


ADezii
Expert 5K+
P: 8,627
If prmProjectGroup is an Option Group, then Case Values for
Expand|Select|Wrap|Line Numbers
  1. Select Case prmProjectGroup 
will be Numeric and not Text.
Sep 14 '16 #2

Post your reply

Sign in to post your reply or Sign up for a free account.