access inactive excel worksheet in outlook

[Art Eby]

hello,

I am trying to run an outlook vba script when i receive a new email. It will take certain values in one excel worksheet and copy them to another worksheet in the same workbook.
to do this i activate "Sheet 1", but when i try to copy certain Sheet 1 values to Sheet 2, i get (run time error '1004': application-defined or object-defined error). I think the problem is that Sheet 2 isn't activated. Is there any way to insert values in Sheet 2 without deactivating Sheet 1?Any help would be appreciated! Thanks in advance.

[gmayor]

You don't need to activate a sheet in order to process it. Set a variable to the sheet e.g.


Set xlWb = xlApp.workbooks.Open("C:\Path\Workbookname.xlsx")
Set xlsheet1 = xlWb.sheets("Sheet1") 'The sheet to copy from
Set xlsheet2 = xlWb.sheets("Sheet2") 'the sheet to copy 2
xlsheet2.Range("A1") = xlsheet1.Range("A1") 'copy A1 from one sheet to the other

If you want more help, post your code.

[Art Eby]

Thank-you
That took care of that problem, but now I ran into another. If the "TargetWB" is open when the script is run sometimes it will hang up on line 44 (Method 'rows' of object'_Global' failed). It doesn't do it if the workbook is not open.
Possibly the function IsAppRunning() is making a problem? Is there a better way to test if excel is open? Thank-you.


[code]

[Art Eby]

sorry. i wasn't ready to send it yet. Here the rest of code is.

Thank-you
That took care of that problem, but now I ran into another. If the "TargetWB" is open when the script is run sometimes it will hang up on line 44 (Method 'rows' of object'_Global' failed). It doesn't do it if the workbook is not open.
Possibly the function IsAppRunning() is making a problem? Is there a better way to test if excel is open? Thank-you.


[code]

Function IsAppRunning(ByVal sAppName) As Boolean
Dim oApp As Object
On Error Resume Next
Set oApp = GetObject(, sAppName)
If Not oApp Is Nothing Then
Set oApp = Nothing
IsAppRunning = True
End If
End Function


[code]

Public Sub MillMaintenace3(Newmail As MailItem)

Dim xlApp As Object
Dim Equipment As Worksheet
Dim ScheduledTasks As Worksheet
Dim CompletedTaskHistory
Dim TasksInProgress As Worksheet
Dim xlWb As Workbook
Dim LastRowTasksInProgress As Long
Dim TargetWB As String
Dim LastRowScheduledTasks As Long
Dim LastRowEquipment As Long
Dim LastRowCompletedTaskHistory As Long
Dim Task As String
Dim x As Long
Dim y As Long
Dim z As Long
Dim i As Long

If IsAppRunning("Excel.Application") = False Then
Set xlApp = CreateObject("Excel.Application")
Else
Set xlApp = GetObject(, "Excel.Application")
End If

TargetWB = "C:\Users\Argyl\Desktop\mill maintenance last edited1-18-17.xlsm"

For Each Workbook In xlApp.Workbooks
If Workbook.FullName = TargetWB Then
Workbook.Close (True)
Else
MsgBox Workbook.FullName
End If

Next Workbook


Set xlWb = xlApp.Workbooks.Open(TargetWB)
Set Equipment = xlWb.Sheets("Equipment")
Set ScheduledTasks = xlWb.Sheets("Scheduled Tasks")
Set TasksInProgress = xlWb.Sheets("Tasks in Progress")
Set CompletedTaskHistory = xlWb.Sheets("Completed Task History")

LastRowScheduledTasks = ScheduledTasks.Range("A" & Rows.Count).End(xlUp).Row

LastRowEquipment = Equipment.Range("A" & Rows.Count).End(xlUp).Row

LastRowCompletedTaskHistory = CompletedTaskHistory.Range("A" & Rows.Count).End(xlUp).Row

LastRowTasksInProgress = TasksInProgress.Range("A" & Rows.Count).End(xlUp).Row

TasksInProgress.Activate

For x = 2 To LastRowTasksInProgress

If Replace(Newmail.Subject, "RE: ", "") = Cells(x, 2).Value Or Replace(Newmail.Subject, "FWD:", "") = Cells(x, 2).Value Then
Cells(x, 10).Value = Newmail.Subject
Cells(x, 11).Value = Newmail.ReceivedTime
Cells(x, 12).Value = Newmail.Body
Newmail.unread = False

i = 1

CompletedTaskHistory.Cells(LastRowCompletedTaskHistory + i, 1).Value = Cells(x, 1).Value
CompletedTaskHistory.Cells(LastRowCompletedTaskHistory + i, 2).Value = Cells(x, 2).Value
CompletedTaskHistory.Cells(LastRowCompletedTaskHistory + i, 3).Value = Cells(x, 3).Value
CompletedTaskHistory.Cells(LastRowCompletedTaskHistory + i, 4).Value = Cells(x, 4).Value
CompletedTaskHistory.Cells(LastRowCompletedTaskHistory + i, 5).Value = Date
CompletedTaskHistory.Cells(LastRowCompletedTaskHistory + i, 6).Value = Cells(x, 5).Value
CompletedTaskHistory.Cells(LastRowCompletedTaskHistory + i, 7).Value = Cells(x, 6).Value

i = i + 1

For y = 2 To LastRowEquipment

If Cells(x, 1).Value = Worksheets("Equipment").Cells(y, 1).Value Then
Equipment.Cells(y, 7).Value = Date
Equipment.Cells(y, 8).ClearContents

If Equipment.Cells(y, 6).Value = "N\A" Then
Equipment.Cells(y, 6).Value = Date
End If
End If
Next y

For z = 2 To LastRowScheduledTasks
If Replace(Newmail.Subject, "RE: ", "") = Cells(x, 2).Value Or Replace(Newmail.Subject, "FWD:", "") = Cells(x, 2).Value Then
ScheduledTasks.Rows(z).Delete

End If
Next z

x = x + 1
End If
Next x


ActiveWorkbook.Close (True)

xlApp.Quit

MsgBox "done"
End Sub

[gmayor]

Without the workbook to test the code, the following should be closer to what is required, but is obviously untried.. A reference to the Excel object library is not required as the code uses late binding to Excel. As you are addressing different sheets in that workbook, address the cells by location and not by activating the sheet. As the code uses late binding, you cannot use Excel specific commands such as xlUp but must use their numeric equivalents.


Option Explicit

Function IsAppRunning(ByVal sAppName) As Boolean
Dim oApp As Object
On Error Resume Next
Set oApp = GetObject(, sAppName)
If Not oApp Is Nothing Then
Set oApp = Nothing
IsAppRunning = True
End If
End Function

Public Sub MillMaintenace3(Newmail As MailItem)
Dim xlApp As Object
Dim Equipment As Object
Dim ScheduledTasks As Object
Dim CompletedTaskHistory
Dim TasksInProgress As Object
Dim xlWb As Object
Dim LastRowTasksInProgress As Long
Dim TargetWB As String
Dim LastRowScheduledTasks As Long
Dim LastRowEquipment As Long
Dim LastRowCompletedTaskHistory As Long
Dim Task As String
Dim bExists As Boolean
Dim x As Long
Dim y As Long
Dim z As Long
Dim i As Long

If IsAppRunning("Excel.Application") = False Then
Set xlApp = CreateObject("Excel.Application")
Else
Set xlApp = GetObject(, "Excel.Application")
End If

TargetWB = "C:\Users\Argyl\Desktop\mill maintenance last edited1-18-17.xlsm"

For Each xlWb In xlApp.Workbooks
If xlWb.FullName = TargetWB Then
bExists = True
Exit For
End If
Next xlWb

If Not bExists Then Set xlWb = xlApp.Workbooks.Open(TargetWB)

Set Equipment = xlWb.Sheets("Equipment")
Set ScheduledTasks = xlWb.Sheets("Scheduled Tasks")
Set TasksInProgress = xlWb.Sheets("Tasks in Progress")
Set CompletedTaskHistory = xlWb.Sheets("Completed Task History")

LastRowScheduledTasks = ScheduledTasks.Range("A" & ScheduledTasks.Rows.Count).End(-4162).Row
LastRowEquipment = Equipment.Range("A" & Equipment.Rows.Count).End(-4162).Row
LastRowCompletedTaskHistory = CompletedTaskHistory.Range("A" & CompletedTaskHistory.Rows.Count).End(-4162).Row
LastRowTasksInProgress = TasksInProgress.Range("A" & TasksInProgress.Rows.Count).End(-4162).Row

For x = 2 To LastRowTasksInProgress
With TasksInProgress

If Replace(Newmail.Subject, "RE: ", "") = .Cells(x, 2).Value Or Replace(Newmail.Subject, "FWD:", "") = .Cells(x, 2).Value Then
.Cells(x, 10).Value = Newmail.Subject
.Cells(x, 11).Value = Newmail.ReceivedTime
.Cells(x, 12).Value = Newmail.Body
Newmail.UnRead = False
i = 1

CompletedTaskHistory.Cells(LastRowCompletedTaskHistory + i, 1).Value = .Cells(x, 1).Value
CompletedTaskHistory.Cells(LastRowCompletedTaskHistory + i, 2).Value = .Cells(x, 2).Value
CompletedTaskHistory.Cells(LastRowCompletedTaskHistory + i, 3).Value = .Cells(x, 3).Value
CompletedTaskHistory.Cells(LastRowCompletedTaskHistory + i, 4).Value = .Cells(x, 4).Value
CompletedTaskHistory.Cells(LastRowCompletedTaskHistory + i, 5).Value = Date
CompletedTaskHistory.Cells(LastRowCompletedTaskHistory + i, 6).Value = .Cells(x, 5).Value
CompletedTaskHistory.Cells(LastRowCompletedTaskHistory + i, 7).Value = .Cells(x, 6).Value

i = i + 1

For y = 2 To LastRowEquipment

If .Cells(x, 1).Value = Equipment.Cells(y, 1).Value Then
Equipment.Cells(y, 7).Value = Date
Equipment.Cells(y, 8).ClearContents

If Equipment.Cells(y, 6).Value = "N\A" Then
Equipment.Cells(y, 6).Value = Date
End If
End If
Next y

For z = 2 To LastRowScheduledTasks
If Replace(Newmail.Subject, "RE: ", "") = .Cells(x, 2).Value Or _
Replace(Newmail.Subject, "FWD:", "") = .Cells(x, 2).Value Then
ScheduledTasks.Rows(z).Delete

End If
Next z

x = x + 1
End If
End With
Next x

TasksInProgress.Close (True)
xlApp.Quit
MsgBox "done"
End Sub

[Art Eby]

thanks a lot for your help, that took care of it.