Hello-
My Mail_ActiveSheet() macro works fine until the end, when this error pops up
Run Time Error 91 - Object Variable or With block variable not set
it points to item 1 on debug. 'item 2 works without error, but doesn't email from cell E2 from every sheet.
Any help would be appreciated.
Thanks
![]()
Sub Mail_ActiveSheet() ' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010 Dim FileExtStr As String Dim FileFormatNum As Long Dim Sourcewb As Workbook Dim Destwb As Workbook Dim TempFilePath As String Dim TempFileName As String Dim OutApp As Object Dim OutMail As Object Dim MyObject As Object ' Create object variable. Set MyObject = Sheets(1) ' Create valid object reference. 'MyCount = MyObject.Count With Application .ScreenUpdating = False .EnableEvents = False End With On Error Resume Next Sheets(activesheet.Index + 1).Activate If Err.Number <> 0 Then Sheets(Data).Select For Each sht In Sheets ShtName = sht.Name Set Sourcewb = ActiveWorkbook ' Next, copy the sheet to a new workbook. ' You can also use the following line, instead of using the ActiveSheet object, ' if you know the name of the sheet you want to mail : ' Sheets("Sheet5").Copy activesheet.copy Set Destwb = ActiveWorkbook ' Determine the Excel version, and file extension and format. With Destwb If Val(Application.Version) < 12 Then ' For Excel 2000-2003 FileExtStr = ".xls": FileFormatNum = -4143 Else ' For Excel 2007-2010, exit the subroutine if you answer ' NO in the security dialog that is displayed when you copy ' a sheet from an .xlsm file with macros disabled. If Sourcewb.Name = .Name Then With Application .ScreenUpdating = True .EnableEvents = True End With MsgBox "You answered NO in the security dialog." Exit Sub Else Select Case Sourcewb.FileFormat Case 51: FileExtStr = ".xlsx": FileFormatNum = 51 Case 52: If .HasVBProject Then FileExtStr = ".xlsm": FileFormatNum = 52 Else FileExtStr = ".xlsx": FileFormatNum = 51 End If Case 56: FileExtStr = ".xls": FileFormatNum = 56 Case Else: FileExtStr = ".xlsb": FileFormatNum = 50 End Select End If End If End With ' You can use the following statements to change all cells in the ' worksheet to values. ' With Destwb.Sheets(1).UsedRange ' .Cells.Copy ' .Cells.PasteSpecial xlPasteValues ' .Cells(1).Select ' End With ' Application.CutCopyMode = False ' Save the new workbook, mail, and then delete it. TempFilePath = Environ$("temp") & "\" TempFileName = "Part of " & Sourcewb.Name & " " _ & " " & MonthName(Month(Date)) & " " & (Year(Date)) & " Commission Statement " Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) 'TempFilePath = "C:\temp\" With Destwb .SaveAs TempFilePath & TempFileName & FileExtStr, _ FileFormat:=FileFormatNum On Error Resume Next ' Change the mail address and subject in the macro before ' running the procedure. With OutMail .From = "noreply@copart.com" .To = activesheet.Range("E2") '.To = "tony.speck@copart.com" .CC = "tony.speck@copart.com" .BCC = "" .Subject = "Macro testing - Please Disregard" .Body = activesheet.Name & " " & MonthName(Month(Date)) & " " & (Year(Date)) & " Commission Statement " .Attachments.Add Destwb.FullName ' You can add other files by uncommenting the following statement. '.Attachments.Add ("C:\test.txt") ' In place of the following statement, you can use ".Display" to ' display the mail. .Send End With On Error GoTo 0 .Close savechanges:=False End With ' Delete the file after sending. Kill TempFilePath & TempFileName & FileExtStr activesheet.Next.Select '[B]item 1[/B] 'activesheet.Move After:=Sheets(ActiveWorkbook.Sheets.Count) '[B]item 2[/B] Set OutMail = Nothing Set OutApp = Nothing Next sht With Application .ScreenUpdating = True .EnableEvents = True End With End Sub











LinkBack URL
About LinkBacks

Register To Reply

Bookmarks