CJM3407
10-27-2010, 02:05 PM
I have a loop that selects pairs of worksheets, then calls Sheets.Copy. It then emails those new Workbooks to an my own email account (still testing). I used the code found here http://www.vbaexpress.com/kb/getarticle.php?kb_id=97 but added functionality to group the sheets.
When the Copy goes off that new workbook, has everything correct except black is white and white is black, in the cells with data. Is this normal. It does this in both 2007 and 2010.
Option Explicit
Sub EmailBlaster()
Dim OL As Object
Dim EmailItem As Object
Dim Wb As Workbook
Dim FileName As String
Dim y As Long
Dim TempChar As String
Dim SaveName As String
Dim wksheet As Worksheet
' Dim olMailItem As Outlook.MailItem
For Each wksheet In ActiveWorkbook.Worksheets
If InStr(1, UCase(wksheet.Name), UCase("Hourly")) = 0 Then
Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Sheets(Array(wksheet.Name, wksheet.Name + " Hourly")).Copy
FileName = wksheet.Name & " Billing Test "
SaveName = FileName
' For y = 1 To Len(FileName)
' TempChar = Mid(FileName, y, 1)
' Select Case TempChar
' Case Is = "/", "\", "*", "?", """", "<", ">", "|", ":"
' Case Else
' SaveName = SaveName & TempChar
' End Select
' Next y
Set Wb = ActiveWorkbook
Wb.SaveAs SaveName
Wb.ChangeFileAccess xlReadOnly
With EmailItem
.Subject = "TESTSUBJECT"
.Body = "TESTBODY" & vbCrLf & _
"Line 2" & vbCrLf & "Line 3"
.To = "MyEmail@MyCompany.org"
.Importance = olImportanceNormal 'Or olImprotanceHigh Or olImprotanceLow
.Attachments.Add Wb.FullName
.Send
End With
Kill Wb.FullName
Wb.Close SaveChanges:=False
Application.ScreenUpdating = True
Set Wb = Nothing
Set OL = Nothing
Set EmailItem = Nothing
End If
Next
End Sub
When the Copy goes off that new workbook, has everything correct except black is white and white is black, in the cells with data. Is this normal. It does this in both 2007 and 2010.
Option Explicit
Sub EmailBlaster()
Dim OL As Object
Dim EmailItem As Object
Dim Wb As Workbook
Dim FileName As String
Dim y As Long
Dim TempChar As String
Dim SaveName As String
Dim wksheet As Worksheet
' Dim olMailItem As Outlook.MailItem
For Each wksheet In ActiveWorkbook.Worksheets
If InStr(1, UCase(wksheet.Name), UCase("Hourly")) = 0 Then
Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Sheets(Array(wksheet.Name, wksheet.Name + " Hourly")).Copy
FileName = wksheet.Name & " Billing Test "
SaveName = FileName
' For y = 1 To Len(FileName)
' TempChar = Mid(FileName, y, 1)
' Select Case TempChar
' Case Is = "/", "\", "*", "?", """", "<", ">", "|", ":"
' Case Else
' SaveName = SaveName & TempChar
' End Select
' Next y
Set Wb = ActiveWorkbook
Wb.SaveAs SaveName
Wb.ChangeFileAccess xlReadOnly
With EmailItem
.Subject = "TESTSUBJECT"
.Body = "TESTBODY" & vbCrLf & _
"Line 2" & vbCrLf & "Line 3"
.To = "MyEmail@MyCompany.org"
.Importance = olImportanceNormal 'Or olImprotanceHigh Or olImprotanceLow
.Attachments.Add Wb.FullName
.Send
End With
Kill Wb.FullName
Wb.Close SaveChanges:=False
Application.ScreenUpdating = True
Set Wb = Nothing
Set OL = Nothing
Set EmailItem = Nothing
End If
Next
End Sub