ต้องการเลือกช่วง column ใน sheet และส่ง mail

[bkkrong]

ผมอยากเลือก column K1:N500 ใน sheet "stock_Item" (sheet11) มา copy แล้วใส่ใน workbook ใหม่ชื่อ PriorityCHK แล้วส่ง mail
ปัญหา คือ ไม่ได้ sheet ช่วงที่ต้องการ ไม่รู้ว่าควรปรับสูตรตรงไหนครับ

Code: Select all

Sub ZPriorityCHK_Email()
    Dim oApp As Object
    Dim oMail As Object
    Dim WB As Workbook
    Dim FileName As String
    Dim wSht As Worksheet
    Dim shtName As String

    Application.ScreenUpdating = False
Sheet11.Activate
    ' Make a copy of the active worksheet
    ' and save it to a temporary file
    ActiveSheet.Range("K1:N500").Copy
    Set WB = ActiveWorkbook

    FileName = WB.Worksheets(1).Name
    On Error Resume Next
    Kill "PriorityCHK"
    On Error GoTo 0
    WB.SaveAs FileName:="PriorityCHK"
    Application.CutCopyMode = False
    
    'Create and show the Outlook mail item
    Set oApp = CreateObject("Outlook.Application")
    Set oMail = oApp.CreateItem(0)
    With oMail
        'Uncomment the line below to hard code a recipient
        .To = "br@gmail.com"
        .CC = "bcer@gmail.com" & ";" & "ban2561@gmail.com"
        'Uncomment the line below to hard code a subject
        .Subject = "¢ÍÊ觢éÍÁÙÅÊÔ¹¤éÒ¤§¤Åѧ㹠stock"
        'Uncomment the lines below to hard code a body
        .body = "àÃÕ¹ ËÁÍâ¡Ð ·Õèà¤ÒþÃÑ¡ " & vbNewLine & _
          "Here is the file you asked for á¼¹¨Ñ´«×éÍàÃÔèÁáá»ÃШӻÕ" & vbNewLine & vbNewLine & vbNewLine & vbNewLine & _
          " ¨Ò¡ ¹Ç¡ ·Ñ¹µ ¤Ð." & vbNewLine & vbNewLine & vbNewLine & vbNewLine & vbNewLine & vbNewLine & _
          "This is Automate by DentalAI_Excel"

        .Attachments.Add WB.FullName
        .Display
    End With

    'Delete the temporary file
    WB.ChangeFileAccess Mode:=xlReadOnly
    Kill WB.FullName
    WB.Close SaveChanges:=False

    'Restore screen updating and release Outlook
    Application.ScreenUpdating = True
    Set oMail = Nothing
    Set oApp = Nothing
    Application.CutCopyMode = False
End Sub

[snasui]

ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub ZPriorityCHK_Email()
    Dim oApp As Object
    Dim oMail As Object
    Dim WB As Workbook
    Dim FileName As String
    Dim wSht As Worksheet
    Dim shtName As String
    Dim sourceRng As Range
    Application.ScreenUpdating = False
    Sheet11.Activate
    ' Make a copy of the active worksheet
    ' and save it to a temporary file
    
    Set sourceRng = ActiveSheet.Range("K1:N500")
    
    ActiveSheet.Copy
    With ActiveSheet
        .Cells.Clear
        sourceRng.Copy .Range("a1")
    End With
    Set WB = ActiveWorkbook

    FileName = WB.Worksheets(1).Name
    On Error Resume Next
'Other code