Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations TouchToneTommy on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

How to pass Excel Application and Workbook to another routine?

Status
Not open for further replies.

ChrisOjeda

Programmer
Apr 16, 2003
45
US
Hi,
I need help passing an Excell Application Object and Excel Workbook object to a sub routine. I've tried putting the in the call but I get error expecting ":=". Also, this is my first code written in VBA in 5 years so if you see any major flaws please point that out too... Thanks... Chris

Option Explicit
Public Sub Command0_Click()
Dim objXL As Object
Dim objActiveWkb As Object
Dim objActiveSht As String
Dim booXLOpen As Boolean
Dim strMsg As String
Dim strPath As String 'Path to Excel document
Dim strPassword As String
Dim datAsOfDate As Date
Dim intAsOfDate As Integer
Dim intUpdateRow As Integer

'DoCmd.Hourglass True
' Initialize variables
strPath = "C:\WINNT\Profiles\wojeda\Desktop\LRDailyDQ 04-03.xls"
strPassword = "adam12"


' Defer error trapping.
On Error Resume Next


' Get Excel if open and assign to objXL.
' Check if no errors to verify if Excel was open.
' If Excel was open then save the users current workbook.
Set objXL = GetObject(, "Excel.Application")
If Err.Number = 0 Then
objXL.ActiveWorkbook.Close savechanges:=True ' Save and close current workbook.
strMsg = MsgBox("Excel is open, Any open workbooks will be saved, Click OK", vbOKOnly)
booXLOpen = True
End If


' Reset all properties of the Error Object.
Err.Clear


' If Excel was not open then open Excel.
If objXL Is Nothing Then
Set objXL = CreateObject("Excel.Application")
End If


' Open Excel using the password assigned to strPassword.
objXL.workbooks.Open strPath, , , , , strPassword
objXL.WindowState = xlMaximized ' Make the Excel Window Maximized
objXL.ActiveWindow.Visible = True ' Make the active Excel window visible
objXL.Visible = True ' Make the Excel application window visible


' Initialize the objActiveSht variable
' Set the active workbook and worksheet.
' Obtain the the rown to be updated based upon As Of Date.
objActiveSht = "ALL SERVICED"
Set objActiveWkb = objXL.Application.ActiveWorkbook
Sheets(objActiveSht).Select
For intAsOfDate = 4 To 27 Step 1
datAsOfDate = objActiveWkb.Worksheets(objActiveSht).Cells(intAsOfDate, 2).Value
If datAsOfDate = Date Then
intUpdateRow = intAsOfDate
Exit For
End If
Next intAsOfDate


' Update Excel based upon each query.
' Pass the Update Row to the sub routine.
Prime (intUpdateRow)






' Save and close workbook. Quit Excel. Destroy objects.
objXL.ActiveWorkbook.Close savechanges:=True
objXL.Application.Quit ' Quit Excel
Set objXL = Nothing ' Destroy Excel Application Object
Set objActiveWkb = Nothing ' Destroy Active Workbook Object


'DoCmd.Hourglass False

End Sub


Public Sub Prime(intUpdateRow As Integer)
Dim cnCurrent As ADODB.Connection
Dim rstDailyDQ As ADODB.Recordset
Dim intRecordCount As Integer
Dim objActiveSht As String

intRecordCount = 0
objActiveSht = "Prime"


Set cnCurrent = CurrentProject.Connection
Set rstDailyDQ = New ADODB.Recordset
rstDailyDQ.ActiveConnection = cnCurrent
rstDailyDQ.Open ("qryPrime")
MsgBox ("loop starting")
With rstDailyDQ
.MoveFirst
Do Until rstDailyDQ.EOF
MsgBox (intRecordCount)
If rstDailyDQ![DAYS DQ] = "A- CURRENT" Then
objActiveWkb.Worksheets(objActiveSht).Cells(intUpdateRow, 4) = rstDailyDQ![LOAN COUNT]
End If
intRecordCount = intRecordCount + 1
.MoveNext
Loop
.Close
End With

End Sub
 
Not sure what you are trying to do but here is some generic ideas to maybe help point you.

Call MySub(ActiveWorkbook)

Sub MySub(objXLWorkBook As WorkBook)
MsgBox objXLWorkBook.Name
End Sub

MsgBox MyFunc(objXLApp).Rows

Function MyFunc(objXL As Object) As Worksheet
MsgBox objXL.ActiveSheet.Name
MyFunc = ActiveSheet
End Function

Good Luck!

 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top