ChrisOjeda
Programmer
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
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