將EXCEL內指定範圍的內容複製至郵件並發信給指定欄位的使用者

temp11111

將EXCEL內指定範圍的內容複製至郵件並發信給指定欄位的使用者

需求是

提取"公務用"sheet內的

第2行A,B,C,D,F,G,H,I,J,K,L,M,N,O,S,欄標題與搭配資料第一筆(第3行),

轉置貼上於郵件內文與附件檔案

發信給第3行K欄的MAIL地址

接著是

第2行A,B,C,D,F,G,H,I,J,K,L,M,N,O,S,欄標題與搭配資料第二筆(第4行),

轉置貼上於郵件內文與附件檔案

發信給第4行K欄的MAIL地址

接著是

第2行A,B,C,D,F,G,H,I,J,K,L,M,N,O,S,欄標題與搭配資料第二筆(第5行),

轉置貼上於郵件內文與附件檔案

發信給第5行K欄的MAIL地址

一直往下直至A列無資料

補充: 附件是將指定範圍的內容存成一個檔案.不是整個原始的EXCLE檔案

請各位老師幫幫忙

謝謝

temp11111

拜託幫幫忙{:soso_e109:}

有再努力爬文
爬到類似
请教range复制到outlook email里的问题
To: mineshine老师。（Excel自动发邮件延伸问题）

能否截获表格(a1:g8)的区域数据放在outlook上
添加邮件附件语句。。。。。

還是湊不出需求
請各位給我一隻手吧
謝謝!

mineshine

temp11111 发表于 2012-2-1 13:40
拜託幫幫忙

有再努力爬文

我不是用office2007以上版本

存成Excel2000版本
你試看看

temp11111

mineshine 发表于 2012-2-1 15:00
我不是用office2007以上版本

存成Excel2000版本

老師.. 感謝您的協助
但是通通都是發一樣內容的耶?
可能是我描述的不清楚
每一封是長類似這樣的內容是不一樣的
若是能轉置當然最好 不能的話 橫著一列也沒關係
要再次麻煩您了
謝謝


發給temp12@yahoo.com 如下面這樣並附件

區域	桃園
單位	M6
縣市-區域-路段	桃園-林口-振興路
專案名稱	工程專案A
專案經理人名	余XX
專案經理電話	0980-000001
專案經理E-Mail	temp2@yahoo.com
聯絡人E-Mail	temp12@yahoo.com
事業處電話	0980-000001
備註3
人員數量	10
備註4
地址	新北市五股區成泰路一段100巷10號10樓之11

發給temp13@yahoo.com 如下面這樣並附件

區域	桃園
單位	M7
縣市-區域-路段	桃園-桃園市-建國東路
專案名稱	工程專案A
專案經理人名	余XX
專案經理電話	0980-000002
專案經理E-Mail	temp3@yahoo.com
聯絡人E-Mail	temp13@yahoo.com
事業處電話	0980-000002
備註3
人員數量	11
備註4
地址	新北市五股區成泰路一段100巷10號10樓之12

發給 temp14@yahoo.com 如下面這樣並附件

區域	桃園
單位	M8
縣市-區域-路段	桃園-大園-中山北路
專案名稱	工程專案A
專案經理人名	余XX
專案經理電話	0980-000003
專案經理E-Mail	temp4@yahoo.com
聯絡人E-Mail	temp14@yahoo.com
事業處電話	0980-000003
備註3
人員數量	12
備註4
地址	新北市五股區成泰路一段100巷10號10樓之13

mineshine

temp11111 发表于 2012-2-1 15:33
老師.. 感謝您的協助
但是通通都是發一樣內容的耶?
可能是我描述的不清楚

修改如下
忘了將對應內容寫入

temp11111

mineshine 发表于 2012-2-1 16:12
修改如下
忘了將對應內容寫入

老師您好 狀況相同耶!!
不知道是不是我是OFFICE 2007的關係

temp11111

mineshine 发表于 2012-2-1 16:12
修改如下
忘了將對應內容寫入

老師您好 我使用2010也是出現相同的情況



我是使用您上傳的 應該沒錯吧
勞您老師再次幫忙了
謝謝

temp11111

老師您好:
我看與然是抓取我"問題"中的範例!
不是"公務用"表格的資料


'Mail worksheet in the body of the mail http://www.rondebruin.nl/mail/folder3/mail2.htm
Sub Mail_Sheet_Outlook_Body()
' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2007
    Dim rng As Range, S1 As Worksheet, S2 As Worksheet, Tit(18), i&, j%
    Dim OutApp As Object
    Dim OutMail As Object
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    Set S1 = Sheets("問題")
    Set S2 = Sheets("公務用")
    '-------------標題-------------------------------------
    j = 1
    With S2
        For i = 1 To 19
            If i <> 5 And i <> 16 And i <> 17 And i <> 18 Then
                j = j + 1
                S1.Cells(j, 1) = .Cells(2, i)
            End If
        Next i
    End With
    '------------------------------------------------------
    For i = 3 To S2.[A65536].End(xlUp).Row
        '內容
        j = 1
        With S2
            For k = 1 To 19
                If k <> 5 And k <> 16 And k <> 17 And k <> 18 Then
                    j = j + 1
                    S1.Cells(j, 1) = .Cells(i, k)
                End If
            Next k
        End With
   
        Set rng = Nothing
        'Set rng = ActiveSheet.UsedRange
        'You can also use a sheet name
        Set rng = S1.Range("A2:B19")
        Set NewWB = Workbooks.Add(xlWBATWorksheet)

        rng.Copy
        With NewWB.Sheets(1)
            .Cells(1).PasteSpecial Paste:=8
            .Cells(1).PasteSpecial Paste:=xlPasteValues
            .Cells(1).PasteSpecial Paste:=xlPasteFormats
            .Cells(1).Select
            Application.CutCopyMode = False
        End With

mineshine

temp11111 发表于 2012-2-1 17:54
老師您好:
我看與然是抓取我"問題"中的範例!
不是"公務用"表格的資料

office2010下修改

temp11111

mineshine 发表于 2012-2-1 19:53
office2010下修改

感謝老師! 這次看起來正常
但是我我將我發問的那個SHEET"問題"刪除後.就不能正常工作了
再看不太懂的程式法中發現有用到"問題"這個SHEET
請問這個SHEET用途是什麼?
可被刪除嗎
再次請教老師了
謝謝

補充:再次測試把表的內容清空依然可以生成只是少了格子(可以接受)
努力看語法中