save worksheets as a wb and email them

[GS7CLW]

Trying to "scroll" thru the worksheets in a wb and move them to a workbook and email taht work book. This code works for only the first sheet in the book then it hangs on:

ActiveWorkbook.Worksheets(I).Select

Sub EmailSheets()
Dim Worksheet
Dim RSID As String
Dim WS_Count As Integer
   Dim I As Integer
   ' Set WS_Count equal to the number of worksheets in the active
   ' workbook.
   WS_Count = ActiveWorkbook.Worksheets.Count
   ' Begin the loop.
   For I = 1 To WS_Count
    ActiveWorkbook.Worksheets(I).Select  '--- HANGS UP ON THIS LINE ---
    RSID = ActiveSheet.Name
    Dim OL              As Object
    Dim EmailItem       As Object
    Dim wb              As Workbook
    Set OL = CreateObject("Outlook.Application")
    Set EmailItem = OL.CreateItem(olMailItem)
    Set wb = ActiveWorkbook
    wb.Save
    
    Sheets(RSID).Select
    Sheets(RSID).Move
    ActiveWorkbook.SaveAs Filename:= _
        "[URL="file://\\Ac35dfsps02p\s3_data$\FLR"]\\Ac35dfsps02p\s3_data$\FLR[/URL] CDR\" & RSID & ".xls", FileFormat:=xlExcel8 _
        , Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
    With EmailItem
        .Subject = "Unassigned Leads Report for " & RSID
        .Body = "  Unassigned Leads Report for " & RSID & " (" & RSID & ".xlsm) attached!" & vbCrLf & _
        "  " & vbCrLf & _
          "  "
        .To = RSID & "@SOMEWHERE.COM"
       ' .Importance = olImportanceNormal 'Or olImprotanceHigh Or olImprotanceLow
        .Attachments.Add wb.FullName ' change this name for each rsid
        UserForm1.Label1.Caption = "Emailing your report to" & RSID
        UserForm1.Repaint
        .Send
    End With
    Set wb = Nothing
    Set OL = Nothing
    Set EmailItem = Nothing
   Next I
End Sub

 

[John_w]

Move will fail anyway when it tries to move the last sheet because a workbook must contain at least one sheet. Therefore try Sheets(I).Copy instead of the Move and after the SaveAs add:

ActiveWorkbook.Close savechanges:=False

I'm not sure if the .Attachments.Add wb.FullName is correct. Shouldn't it be the same as the file name specified in the SaveAs? Also the Selects are unnecessary; you can reference sheets directly, e.g. Sheets(I).Name.

 

[GS7CLW]

It does cycle thru the entire workbook NOW, and it does save each sheet as a wb. I believe you are right about the:

Attachments.Add wb.FullName

not being right as the emails go out with the original Unassignedleads.xlsx rather than the RSID.xlsx (i.e.5D2W.xlsx) attached to it..

 

[GS7CLW]

not sure how to go about naming the attachment here:

Attachments.Add wb.FullName

for each email I use
RSID@somewhere.com
RSID is also the name of the sheet and resulting file (i.e.):
5D2W.xls

 

[John_w]

It does cycle thru the entire workbook NOW, and it does save each sheet as a wb

But you said that the code only works for the first sheet and then hangs (on the second sheet). Have you tried the changes I suggested?

not sure how to go about naming the attachment here:

Attachments.Add wb.FullName

The same as the SaveAs file name:

.Attachments.Add "\\Ac35dfsps02p\s3_data$\FLR CDR\" & RSID & ".xls"

 

[GS7CLW]

worked great!!!!!!!!!!

almost done with this project need to make some minor changes
but it's nothing I can't handle. Do want to thank everyone for ALL their help. I truly appreciate all of it. Hope evryone has a great week/end!!!

Thanks to all
cliff