Results 1 to 8 of 8
  1. #1
    5 Star Lounger
    Join Date
    Feb 2008
    Posts
    1,004
    Thanks
    63
    Thanked 2 Times in 2 Posts

    Macro to extract sheet and email

    I would like to extract a sheet called "Man accounts bank" from my workbook Br1 Man report, to save this sheet and attach this sheet to an email

    I have code to do this, but I get a run time error and the following code is highlighted



    Code:
     ActiveWorkbook.SaveAs Replace(vFilenames(lCount), ".xls", "") & ".Man Accounts bank.xls", FileFormat:=xlNormal
    My full code is as follows:

    Code:
     Sub SendFiles()
        Dim lCount As Long
        Dim vFilenames As Variant
        Dim sPath As String
        Dim lFilecount As Long
        Dim sFullName As String
        sPath = "C:\My Documents\"
        ChDrive sPath
        ChDir sPath
       
            Application.DisplayAlerts = False
            Application.CutCopyMode = False
           Sheets(Array("Man Accounts Bank")).Copy
            ActiveWorkbook.SaveAs Replace(vFilenames(lCount), ".xls", "") & ".Man Accounts bank.xls", FileFormat:=xlNormal
            vFilenames(lCount) = ActiveWorkbook.FullName
            Application.ScreenUpdating = False
            For Each sht In Sheets(Array("Man Accounts bank"))
            Sheets(sht.Name).UsedRange.Copy
            Sheets(sht.Name).Range("a1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            Next
            Application.ScreenUpdating = True
            ActiveWorkbook.Close True
            Application.DisplayAlerts = True
            Application.CutCopyMode = True
       
          'Mailfiles "dave.peters$@gmail.com", vFilenames
        For lCount = LBound(vFilenames) To UBound(vFilenames)
    Kill vFilenames(lCount)
    Next
       ActiveWorkbook.Close False
    End Sub
    Code:
     Sub Mailfiles(sMailAddress As String, vFiles As Variant)
        Dim oMailItem As Object
        Dim oOLapp As Object
        Dim lCt As Long
    
        Set oOLapp = CreateObject("Outlook.application")
        Set oMailItem = oOLapp.CreateItem(0)
        With oMailItem
            .To = sMailAddress
            .Subject = "Group Accounts"
           .body = "Attached please find Group accounts as at " & Format(Month(Date) - 1 & " " & Year(Date), "mmm yyyy") & " & vbNewLine & vbNewLine"
           
                      
                  .body = .body & "Regards" & vbNewLine & vbNewLine
    .body = .body & "Howard"
    
     For lCt = LBound(vFiles) To UBound(vFiles)
                .attachments.Add CStr(vFiles(lCt))
            Next
            .Display
            Set oOLapp = Nothing
            Set oMailItem = Nothing
        End With
       
          
    End Sub
    Your assistance in resolving this is most appreciated.

    I have also posted on MrExcel.com


    http://www.mrexcel.com/forum/excel-q...eet-email.html

  2. Subscribe to our Windows Secrets Newsletter - It's Free!

    Get our unique weekly Newsletter with tips and techniques, how to's and critical updates on Windows 7, Windows 8, Windows XP, Firefox, Internet Explorer, Google, etc. Join our 480,000 subscribers!

    Excel 2013: The Missing Manual

    + Get this BONUS — free!

    Get the most of Excel! Learn about new features, basics of creating a new spreadsheet and using the infamous Ribbon in the first chapter of Excel 2013: The Missing Manual - Subscribe and download Chapter 1 for free!

  3. #2
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    6,058
    Thanks
    196
    Thanked 765 Times in 699 Posts
    Howard,

    From what I can see neither vFilenames nor lCount have been initialized, i.e given values.
    HTH
    May the Forces of good computing be with you!

    RG

    VBA Rules!

    My Systems: Desktop Specs
    Laptop Specs


  4. #3
    5 Star Lounger
    Join Date
    Feb 2008
    Posts
    1,004
    Thanks
    63
    Thanked 2 Times in 2 Posts
    Thanks RG for pointing this out

    Will include this and test

  5. #4
    5 Star Lounger
    Join Date
    Feb 2008
    Posts
    1,004
    Thanks
    63
    Thanked 2 Times in 2 Posts
    Hi RG

    I am trying extract the sheet "Man accounts Bank" save this as Man Accounts Bank" and attach to email and send

    I am having problems with this section of the code

    I get wrong number of arguments or invalid property assignment -run time error 450

    Code:
     vFilenames = Application.Worksheets





    Code:
     Sub SendFiles()
    Sheets("Man Accounts Bank").Select
        Dim lCount As Long
        Dim vFilenames As Variant
        Dim sPath As String
        Dim lFilecount As Long
        Dim sFullName As String
        sPath = "C:\My Documents\"
        ChDrive sPath
        ChDir sPath
       vFilenames = Application.Worksheets
        If TypeName(vFilenames) = "Boolean" Then Exit Sub
        For lCount = LBound(vFilenames) To UBound(vFilenames)
            Workbooks.Open vFilenames(lCount), UpdateLinks:=False
            Application.DisplayAlerts = False
            Application.CutCopyMode = False
           Sheets(Array("Man Accounts Bank")).Copy
            ActiveWorkbook.SaveAs Replace(vFilenames(lCount), ".xls", "") & ".Man Accounts bank.xls", FileFormat:=xlNormal
            vFilenames(lCount) = ActiveWorkbook.FullName
            Application.ScreenUpdating = False
            For Each sht In Sheets(Array("Man Accounts bank"))
            Sheets(sht.Name).UsedRange.Copy
            Sheets(sht.Name).Range("a1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            Next
            Application.ScreenUpdating = True
            ActiveWorkbook.Close True
            Application.DisplayAlerts = True
            Application.CutCopyMode = True
       
          Mailfiles "zack@gmail.com", vFilenames
        
    Kill vFilenames(lCount)
    Next
       ActiveWorkbook.Close False
    End Sub
    
    Sub Mailfiles(sMailAddress As String, vFiles As Variant)
        Dim oMailItem As Object
        Dim oOLapp As Object
        Dim lCt As Long
    
        Set oOLapp = CreateObject("Outlook.application")
        Set oMailItem = oOLapp.CreateItem(0)
        With oMailItem
            .To = sMailAddress
            .Subject = "Group Accounts"
           .body = "Attached please find Group accounts as at " & Format(Month(Date) - 1 & " " & Year(Date), "mmm yyyy") & " & vbNewLine & vbNewLine"
           
                      
                  .body = .body & "Regards" & vbNewLine & vbNewLine
    .body = .body & "Howard"
    
       For lCt = LBound(vFiles) To UBound(vFiles)
                .attachments.Add CStr(vFiles(lCt))
            Next
            .Display
            Set oOLapp = Nothing
            Set oMailItem = Nothing
        End With
       
          
    End Sub
    It would be appreciated if you could assist
    Last edited by HowardC; 2014-08-04 at 21:45.

  6. #5
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    6,058
    Thanks
    196
    Thanked 765 Times in 699 Posts
    Howard,

    This won't work as you are checking for the wrong type you should be checking for "Empty"
    Empty.JPG

    This line: vFilenames = Application.Worksheets returns the 450 error because it will not return an aggregate value.
    You need to determine the number of sheets, ReDim an existing string array, Loop to load the array.
    SheetNames.JPG

    You now have the sheet names loaded and a count of how many which can be used to run your loop and provide the names. HTH
    May the Forces of good computing be with you!

    RG

    VBA Rules!

    My Systems: Desktop Specs
    Laptop Specs


  7. #6
    5 Star Lounger
    Join Date
    Feb 2008
    Posts
    1,004
    Thanks
    63
    Thanked 2 Times in 2 Posts
    Hi RG

    Thanks for the help

    Have tried to amend my code by incorporating your suggestions, but still cannot get it to work


    Code:
     Sub SendFiles()
        Dim vFilename As Variant
     Debug.Print "Man Acounts Bank.xls"; "(vFilename)"
        Dim sPath As String
        Dim lFilecount As Long
        
         Dim Zfilename() As String
     Dim lCount As Long
    Dim Lcntr As Long
    Dim Lshtcount As Long
    Lshtcount = ActiveWorkbook.Sheets.Count
    ReDim Zfilename(Lshtcount)
    For Lcntr = 1 To Lshtcount - 1
    Zfilename(Lcntr) = ActiveWorkbook.Sheets(Lcntr).Name
    Debug.Print Zfilename(Lcntr)
        
        Dim sFullName As String
        sPath = "C:\My Documents\"
        ChDrive sPath
        ChDir sPath
       'vFilename = Application.Worksheets("Microsoft Excel files (*.xls),*.xls", , "Please select the file(s) to save", , True)
        If TypeName(vFilename) = "Boolean" Then Exit Sub
        'For lCount = LBound(vFilenames) To UBound(vFilenames)
          '  Workbooks.Open vFilenames(lCount), UpdateLinks:=False
            Application.DisplayAlerts = False
            Application.CutCopyMode = False
           Sheets(Array("Man Accounts Bank")).Copy
            ActiveWorkbook.SaveAs Replace(vFilename(Lcntr), ".xls", "") & ".Man Accounts bank.xls", FileFormat:=xlNormal
            'vFilenames(lCount) = ActiveWorkbook.FullName
            Application.ScreenUpdating = False
            For Each sht In Sheets(Array("Man Accounts bank"))
            Sheets(sht.Name).UsedRange.Copy
            Sheets(sht.Name).Range("a1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            Next
            Application.ScreenUpdating = True
            ActiveWorkbook.Close True
            Application.DisplayAlerts = True
            Application.CutCopyMode = True
       
          Mailfiles "zack@gmail.com", vFilenames
        
    'Kill vFilenames(lCount)
    Next Lcntr
    ActiveWorkbook.Close False
    End Sub
    
    Sub Mailfiles(sMailAddress As String, vFiles As Variant)
        Dim oMailItem As Object
        Dim oOLapp As Object
        Dim lCt As Long
    
        Set oOLapp = CreateObject("Outlook.application")
        Set oMailItem = oOLapp.CreateItem(0)
        With oMailItem
            .To = sMailAddress
            .Subject = "Group Accounts"
           .body = "Attached please find Group accounts as at " & Format(Month(Date) - 1 & " " & Year(Date), "mmm yyyy") & " & vbNewLine & vbNewLine"
           
                      
                  .body = .body & "Regards" & vbNewLine & vbNewLine
    .body = .body & "Howard"
    
       For lCt = LBound(vFiles) To UBound(vFiles)
                .attachments.Add CStr(vFiles(lCt))
            Next
            .Display
            Set oOLapp = Nothing
            Set oMailItem = Nothing
        End With
       
          
    End Sub
    I get run time error 13-type mismatch and the following code is highlighted

    Code:
     ActiveWorkbook.SaveAs Replace(vFilename(Lcntr), ".xls", "") & ".Man Accounts bank.xls", FileFormat:=xlNormal
    Please check & correct

    I need the shett "Man Accounts BanK' to be copies and saved as an Xls Sheet , which must be attached and saved

  8. #7
    5 Star Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    1,107
    Thanks
    39
    Thanked 197 Times in 184 Posts
    I would like to extract a sheet called "Man accounts bank" from my workbook Br1 Man report, to save this sheet and attach this sheet to an email
    Howard,

    Seems like you are struggling with this code. I thought it would be better to just start from scratch. This code will create a new workbook using the "Man accounts bank" sheet from your source workbook, save it, then attach it to an email. Since you are using XP, change the path to where you want to save the file. It will automatically save as an Excel 2003 version.

    HTH,
    Maud

    email1.png


    Code:
    Public Sub NewSheet()
    On Error GoTo errorhandler
    '--------------------------------
    'DECLARE AND SET VARIABLES
        Dim wsName As String
        Dim ws1 As Worksheet
        Dim File As String
        wsName = "Man accounts bank"
        Set ws1 = Worksheets(wsName)
    '--------------------------------
    'CREATE NEW WORKBOOK
        Sheets(wsName).Select
        Sheets(wsName).Copy
        Path = "C:\Users\Maudibe\Documents\"  'CHANGE TO YOUR PATH
        File = Path & wsName & ".xls"
        ChDir Path
        ActiveWorkbook.SaveAs Filename:=File, FileFormat:=xlExcel8
    '--------------------------------
    'CREATE EMAIL
        Mailfiles File
        Exit Sub
    '--------------------------------
    'ERROR HANDLING IF WORKBOOK EXISTS
    errorhandler:
        MsgBox "You may already have an existing workbook called Man accounts bank." & Chr(13) & _
        "Please delete it and try again."
    End Sub
    
    Sub Mailfiles(wkBook As String)
    'DECLARE AND SET VARIABLES
        Dim oMailItem As Object
        Dim oOLapp As Object
        Dim lCt As Long
        Dim msg As String
        Set oOLapp = CreateObject("Outlook.application")
        Set oMailItem = oOLapp.CreateItem(0)
    '---------------------------------
    'CREATE EMAIL
        msg = "Attached please find Group accounts as at " & Format(Month(Date) - 1 & " " & Year(Date), "mmm yyyy") & _
            vbNewLine & vbNewLine & "Regards" & vbNewLine & vbNewLine & "Howard"
        With oMailItem
            .To = "zack@gmail.com"
            .Subject = "Group Accounts"
            .body = msg
            .attachments.Add (wkBook)
            .Display
        End With
    '---------------------------------
    'CLEANUP
        Set oOLapp = Nothing
        Set oMailItem = Nothing
    End Sub

  9. The Following User Says Thank You to Maudibe For This Useful Post:

    HowardC (2014-08-05)

  10. #8
    5 Star Lounger
    Join Date
    Feb 2008
    Posts
    1,004
    Thanks
    63
    Thanked 2 Times in 2 Posts
    Hi Maud

    I was indeed battling. Will go through your code so I fully understand the logic

    Thanks for the help, code works perfectly

    Howard

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •