gakiss2
Registered User.
- Local time
- Yesterday, 19:14
- Joined
- Nov 21, 2018
- Messages
- 168
I found some code to open another database off of a button. I have gotten to a point that I can open a form within the target database and open it in 'new record' status. Next I would like to pass some data between the two databases and am looking for some help with that. Any help is appreciated.
' Procedure : OpenDb
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Open another database
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding, so none required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sDb : Fully qualified path and file name with extension of the database to
' open
'
' Usage:
' ~~~~~~
'Call OpenDb("C:\Users\Daniel\Documents\Database25.accdb")
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2014-11-07 Initial Release
' 2 2018-01-21 Error handling updated for posting on website
'---------------------------------------------------------------------------------------
Public Function OpenDb(sDb As String)
On Error GoTo Error_Handler
'Early binding
'Use the following line if being used in Access or using Access reference
' provides intellisense!
Dim oAccess As Access.Application
'Late binding
'Use the following line if being used outside of Access without an Access reference
' Dim oAccess As Object
Set oAccess = CreateObject("Access.Application") 'Create a new Access instance
With oAccess
.OpenCurrentDatabase sDb 'Open the specified db
.Visible = True 'Ensure it is visible to the end-user
.UserControl = True
.DoCmd.OpenForm "frmDocDetail", , , , acFormAdd
' .DoCmd.OpenForm "YourFormName" 'Open a form?
' .DoCmd.RunMacro "YourMacroName" 'Run a Macro?
End With
Error_Handler_Exit:
On Error Resume Next
If Not oAccess Is Nothing Then Set oAccess = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: OpenDb" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit
End Function
Private Sub CmdPRR_Click()
' code to open Quik Docs
' Call function to open database - above
Call OpenDb("C:\Users\gkissick\Desktop\QuikDoc locals\Quik Doc Track GaryV112719.21.accdb")
' code to create the PRR form
' MsgBox "Preparing PRR Form"
Dim oXL As Object
Dim NewFile As String
Set oXL = CreateObject("Excel.Application")
oXL.Visible = True
Set wb = oXL.Workbooks.Open("C:\Users\gkissick\Desktop\PRR.xlsx", True, False)
wb.sheets(1).Range("F2").Value = "YES"
wb.sheets(1).Range("h2").Value = Forms!frmMRRLog!DocReference
wb.sheets(1).Range("c4").Value = Forms!frmMRRLog!SupplierName
wb.sheets(1).Range("h4").Value = Date
wb.sheets(1).Range("c6").Value = Forms!frmMRRLog!item
wb.sheets(1).Range("k17").Value = Forms!frmMRRLog!ProblemDescription
wb.sheets(1).Range("e6").Value = Forms!frmMRRLog!mrr_num
wb.sheets(1).Range("h2").Value = "PRR-" & Year(Date) & "-" & Forms!frmMRRLog!mrr_num
NewFile = "C:\Users\gkissick\Desktop\PRR " & Forms!frmMRRLog!mrr_num
wb.SaveAs FileName:=NewFile, FileFormat:=56
End Sub
' Procedure : OpenDb
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Open another database
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding, so none required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sDb : Fully qualified path and file name with extension of the database to
' open
'
' Usage:
' ~~~~~~
'Call OpenDb("C:\Users\Daniel\Documents\Database25.accdb")
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2014-11-07 Initial Release
' 2 2018-01-21 Error handling updated for posting on website
'---------------------------------------------------------------------------------------
Public Function OpenDb(sDb As String)
On Error GoTo Error_Handler
'Early binding
'Use the following line if being used in Access or using Access reference
' provides intellisense!
Dim oAccess As Access.Application
'Late binding
'Use the following line if being used outside of Access without an Access reference
' Dim oAccess As Object
Set oAccess = CreateObject("Access.Application") 'Create a new Access instance
With oAccess
.OpenCurrentDatabase sDb 'Open the specified db
.Visible = True 'Ensure it is visible to the end-user
.UserControl = True
.DoCmd.OpenForm "frmDocDetail", , , , acFormAdd
' .DoCmd.OpenForm "YourFormName" 'Open a form?
' .DoCmd.RunMacro "YourMacroName" 'Run a Macro?
End With
Error_Handler_Exit:
On Error Resume Next
If Not oAccess Is Nothing Then Set oAccess = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: OpenDb" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit
End Function
Private Sub CmdPRR_Click()
' code to open Quik Docs
' Call function to open database - above
Call OpenDb("C:\Users\gkissick\Desktop\QuikDoc locals\Quik Doc Track GaryV112719.21.accdb")
' code to create the PRR form
' MsgBox "Preparing PRR Form"
Dim oXL As Object
Dim NewFile As String
Set oXL = CreateObject("Excel.Application")
oXL.Visible = True
Set wb = oXL.Workbooks.Open("C:\Users\gkissick\Desktop\PRR.xlsx", True, False)
wb.sheets(1).Range("F2").Value = "YES"
wb.sheets(1).Range("h2").Value = Forms!frmMRRLog!DocReference
wb.sheets(1).Range("c4").Value = Forms!frmMRRLog!SupplierName
wb.sheets(1).Range("h4").Value = Date
wb.sheets(1).Range("c6").Value = Forms!frmMRRLog!item
wb.sheets(1).Range("k17").Value = Forms!frmMRRLog!ProblemDescription
wb.sheets(1).Range("e6").Value = Forms!frmMRRLog!mrr_num
wb.sheets(1).Range("h2").Value = "PRR-" & Year(Date) & "-" & Forms!frmMRRLog!mrr_num
NewFile = "C:\Users\gkissick\Desktop\PRR " & Forms!frmMRRLog!mrr_num
wb.SaveAs FileName:=NewFile, FileFormat:=56
End Sub