以下vb代码在特定记录中打开数据库表单。然后,我想运行附加到表单上的按钮的事件过程。我已经尝试创建一个运行该过程的宏,但是在运行vb脚本时,它说无法找到该过程。我甚至尝试将事件程序从私人更改为公共但无济于事。我甚至还试过把程序的名称改为Macro1,但仍然没有。我可能会错过什么。
这是vb脚本:
Set accessApp = CreateObject("Access.Application")
accessApp.OpenCurrentDataBase "M:\Shared Documents\Job Cost Analysis\TRAINING JOBCOST ANALYSIS DATABASE\Job_Cost_Analysis_Tracking_Training.accdb", false
accessApp.visible = true
accessApp.UserControl = true
accessApp.DoCmd.OpenForm "frmClients", , , "Clients!client_id= 100005 ", , acWindowNormal, True
accessApp.Forms("frmClients").status_ID=3
accessApp.Run "cmdImportItemStmt_Click"
accessApp.Forms("frmClients").status_ID=34
accessApp.Save
以下是访问过程:
Private Sub cmdImportItemStmt_Click()
On Error GoTo Problems
Dim filename As String
'***** CHECK TO MAKE SURE STATUS IS IN ITEMIZED STATEMENT IMPORT ***********
If Me.status_ID.Column(1) = 3 Then
If IsNull(Me.frmItemizedStmtTotals("AMT DISPUTED").Value) = True Then
filename = (copyQueue & "CLIENT_" & CStr(Me.client_ID.Value) & "\Client_" & CStr(Me.client_ID.Value) & ".xlsx")
DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel12, "Sheet1", filename, True
DoCmd.SetWarnings (WarningsOff)
'**********APPEND ITEMIZED STATEMENT***********
DoCmd.OpenQuery "append_itemized_stmt_import"
'**********UPDATE ITEMIZED STATEMENT W/ REASON CODES***********
DoCmd.OpenQuery "Update_reason_codes_by_desc_null_revcodes"
DoCmd.OpenQuery "Update_reason_codes_by_desc"
'************** If facility is OHSU remove non-billable items per contract**********
If Me.facility_ID = 102 Then
DoCmd.OpenQuery "qryOHSU_nonbillable"
End If
'**************************************************************
Me.frmISAmtsByRevenueCodes.Requery
Me.frmItemizedStmtTotals.Requery
DoCmd.DeleteObject acTable, "Sheet1"
DoCmd.SetWarnings (WarningsOn)
Else
MsgBox "UNABLE TO IMPORT IS RECORDS BECAUSE THE ITEMIZED" & vbCrLf & _
"STATEMENT'S TOTAL BILLED CHARGES ALREADY HAS A" & vbCrLf & _
"BALANCE > THAN ZERO INDICATING A PREVIOUS IMPORT", vbOKOnly, "UNABLE TO IMPORT IS RECORDS"
End If
Else
MsgBox "INACCURATE CLAIM REVIEW STATUS" & vbCrLf & _
"FOR ITEMIZED STATEMENT IMPORT", vbOKOnly, "INACCURATE CLAIM REVIEW STATUS"
End If
RecalculateTotals
Exit Sub
Problems:
Err.Clear
Resume Next
End Sub
答案 0 :(得分:2)
用于测试的VBS脚本(基于您的):
Set accessApp = CreateObject("Access.Application")
accessApp.OpenCurrentDataBase "C:\Temp\Database1.mdb"
accessApp.UserControl = true
accessApp.Run "Test1"
并在MS Access数据库中测试代码。
你可以毫无问题地运行吗?
答案 1 :(得分:0)
通过在程序中将Me.
更改为Forms!frmClients!
,我能够让它正常运行。我想vb脚本不喜欢Me.
,因为脚本是在访问之外运行的。
Public Sub ImportItemStmt()
On Error GoTo Problems
Dim filename As String
'***** CHECK TO MAKE SURE STATUS IS IN ITEMIZED STATEMENT IMPORT ***********
If Forms!frmClients!status_ID.Column(1) = 3 Then
If IsNull(Forms!frmClients!frmItemizedStmtTotals("AMT DISPUTED").Value) = True Then
filename = (copyQueue & "CLIENT_" & CStr([Forms]![frmClients]![client_ID].Value) & "\Client_" & CStr([Forms]![frmClients]![client_ID].Value) & ".xlsx")
DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel12, "Sheet1", filename, True
DoCmd.SetWarnings (WarningsOff)
'**********APPEND ITEMIZED STATEMENT***********
DoCmd.OpenQuery "append_itemized_stmt_import"
'**********UPDATE ITEMIZED STATEMENT W/ REASON CODES***********
DoCmd.OpenQuery "Update_reason_codes_by_desc_null_revcodes"
DoCmd.OpenQuery "Update_reason_codes_by_desc"
'************** If facility is OHSU remove non-billable items per contract**********
If Forms!frmClients!facility_ID = 102 Then
DoCmd.OpenQuery "qryOHSU_nonbillable"
End If
'**************************************************************
Forms!frmClients!frmISAmtsByRevenueCodes.Requery
Forms!frmClients!frmItemizedStmtTotals.Requery
DoCmd.DeleteObject acTable, "Sheet1"
DoCmd.SetWarnings (WarningsOn)
Else
MsgBox "UNABLE TO IMPORT IS RECORDS BECAUSE THE ITEMIZED" & vbCrLf & _
"STATEMENT'S TOTAL BILLED CHARGES ALREADY HAS A" & vbCrLf & _
"BALANCE > THAN ZERO INDICATING A PREVIOUS IMPORT", vbOKOnly, "UNABLE TO IMPORT IS RECORDS"
End If
Else
MsgBox "INACCURATE CLAIM REVIEW STATUS" & vbCrLf & _
"FOR ITEMIZED STATEMENT IMPORT", vbOKOnly, "INACCURATE CLAIM REVIEW STATUS"
End If
'RecalculateTotals
Exit Sub
Problems:
Err.Clear
Resume Next
End Sub