c_c_lai

回復  GBKEE
回覆GBKEE: 重新在檢查測試其他檔案,都不行複製三個以上的sheet!  Sheets(Array("TEST", "RA ...
jackyliu 發表於 2013-8-28 15:30

附上檔案，請參考：
樞紐整理完畢後複製到新的檔案問題.rar (20.46 KB)

下載次數: 4

2013-8-28 15:44

jackyliu

回復 11# c_c_lai
感謝c_c_lai ,大力幫忙 ! 複製新檔案完成,沒問題了
若將依日期時間產生的檔案,要mail出去,
我之前都是一直指定同一個檔案,但目前做法是要將
剛才產生的mail出去,可否指導一下 !

我之前附件寫法如下: 不知道要如何 將剛產生的的檔案,要mail出去(日期時間命名檔案)
CDO_Mail_Object.AddAttachment "D:\TEMP\test.xls"

c_c_lai

回復 12# jackyliu
有關 Send Mail Using CDO，我從國外網站摘錄了一篇，請參考：

1. ' Send Mail Using CDO
   
2. Public Sub testCDO()
   
3. '  Purpose   Demondtrate Sending an Email with an attachment using CDO (Collaboration Data Objects)
   
4. '           Uses Late Binding - Does not need a reference to the Microsoft CDO For Windows library
   
5. '           cdosys comes innstalled as standard on Windows 2K and higher workstations and servers
   
6. '           This code will fail on NT4, Win 98, and Win 95 where the cdosys.dll is not present
   
7. '  Author    Ron Weiner    rweiner@WorksRite.com
   
8. '           Copyrite © 2004-2005 WorksRite Software Solutions
   
9. '           You may use this code example for any purpose what-so-ever with
   
10. '           acknowledgement. However, you may not publish the code without
    
11. '           the express, written permission of the author.
    
12.     Const cdoSendUsingPort = 2
    
13.     Const cdoBasic = 1
    
14.     Dim objCDOConfig As Object, objCDOMessage As Object
    
15.     Dim strSch As String
    
16. 
    
17.     strSch = "http://schemas.microsoft.com/cdo/configuration/"
    
18.     Set objCDOConfig = CreateObject("CDO.Configuration")
    
19.     With objCDOConfig.Fields
    
20.         .Item(strSch & "sendusing") = cdoSendUsingPort
    
21.         .Item(strSch & "smtpserver") = "SMTP.ServerName.Com"
    
22.         ' Only used if SMTP server requires Authentication
    
23.         .Item(strSch & "smtpauthenticate") = cdoBasic
    
24.         .Item(strSch & "sendusername") = "SomeMailBox@SomeDomain.com"
    
25.         .Item(strSch & "sendpassword") = "YourPassword"
    
26.         .Update
    
27.     End With
    
28. 
    
29.     Set objCDOMessage = CreateObject("CDO.Message")
    
30.     With objCDOMessage
    
31.         Set .Configuration = objCDOConfig
    
32.         .from = "Senders Pretty Name"
    
33.         .sender = "SomeMailBox@SomeDomain.com"
    
34.         .To = "SomeOne@SomeWhere.com"
    
35.         .Subject = "Sample CDO Message"
    
36.         ' Use TextBody to send Email in Plain Text Format
    
37.         '.TextBody = "This is a test for CDO message"
    
38.         ' Use HTMLBody to send Email in Rich Text (HTML) Format
    
39.         .HTMLBody = "Test CDO Rich Text this is not Bold But <B>This is!</B>"
    
40.         ' Adding Attachments is easy enough
    
41.         .AddAttachment "c:\SomeFile.zip"
    
42.         .AddAttachment "c:\SomeOtherFile.pdf"
    
43.         ' Un-Rem next line to get "Return Reciept Request"
    
44.         '.MDNRequested = True
    
45.         .Send
    
46.     End With
    
47.     Set objCDOMessage = Nothing
    
48.     Set objCDOConfig = Nothing
    
49. End Sub

複製代碼

jackyliu

回復 13# c_c_lai

我在想fs得到新檔案名稱和路徑 , 將此訊息給 Sub sendmail()副程式, Sub sendmail()副程式就可以附加檔案方式,mail出去了....
Sub main()
fs = ThisWorkbook.Path & "\" & Format(Now, "yyyy_mm_dd hhmm") & ".xls"  '存檔檔名
End Sub

Sub sendmail()副程式,這裡一直是不出來,要如何附加新建立的檔案(檔名為yyyy_mm_dd hhmm.xls)
CDO_Mail_Object.AddAttachment "D:\TEMP\test.xls" 這是我之前指定同一個檔案的方式,不知道要怎麼改
End Sub

以上, 請板大協助 !

c_c_lai

回復 14# jackyliu
這是妳所要的嗎？

1. Sub Ex()
   
2.     Dim fs As String
   
3.    
   
4.     fs = ThisWorkbook.Path & "\" & Format(Now, "yyyy_mm_dd hhmm") & ".xls"  
   
5.     sendmail(fs)
   
6. End Sub
   
7. 
   
8. Sub sendmail(fs As String)
   
9.    CDO_Mail_Object.AddAttachment fs
   
10.     CDO_Mail_Object.Send
    
11. End Sub

複製代碼

c_c_lai

回復 14# jackyliu
因為無法得到 SMTP Server 的位址，我把執行結果列示如下。
之前妳是如何傳送出去？能否把原稿上傳提供實務應用。

下載 (27.12 KB)

2013-8-29 08:09

樞紐整理完畢後複製到新的檔案問題.rar (24.06 KB)

下載次數: 1

2013-8-29 08:10

c_c_lai

回復 14# jackyliu
再修正後連結產生的訊息：(已經加入cdoSendUsingPort 等參數)
關鍵性應是無法正確連結 SMTP Server。

下載 (27.07 KB)

2013-8-29 08:35

1. Sub sendEMail(fd As String)
   
2.     Const cdoSendUsingPort = 2
   
3.     Const cdoBasic = 1
   
4.     Dim objEmail As Object, CDO_Config As Object
   
5.     Dim SMTP_Config As Variant
   
6.     Dim strSch As String
   
7. 
   
8.     strSch = "http://schemas.microsoft.com/cdo/configuration/"
   
9.     Set objEmail = CreateObject("CDO.Message")       '  建立 CDO 物件
   
10.    
    
11.     On Error GoTo debugErr
    
12.     Set CDO_Config = CreateObject("CDO.Configuration")
    
13.     With CDO_Config.Fields
    
14.         .Item(strSch & "sendusing") = cdoSendUsingPort
    
15.         .Item(strSch & "smtpserver") = "SMTP.ServerName.Com"
    
16.         ' Only used if SMTP server requires Authentication
    
17.         .Item(strSch & "smtpauthenticate") = cdoBasic
    
18.         .Item(strSch & "sendusername") = "xxxxxx@gmail.com"
    
19.         .Item(strSch & "sendpassword") = ""
    
20.         .Update
    
21.     End With
    
22. 
    
23.     With objEmail
    
24.         Set .Configuration = CDO_Config
    
25. 
    
26.         .From = "xxxxxx@gmail.com"               '  寄件者（網域必須存在）
    
27.         .To = "xxxxxxx@yahoo.com"                 '  收件者
    
28.         .Subject = "CDO郵件測試"                    '  郵件主旨
    
29.         .TextBody = "郵件測試本文"                 '  郵件內文
    
30.    
    
31.         .AddAttachment fd
    
32.         .Send
    
33.     End With
    
34.    
    
35. debugErr:
    
36.     If Err.Description <> "" Then MsgBox Err.Description
    
37.     Set objEmail = Nothing
    
38.     Set CDO_Config = Nothing
    
39. End Sub

複製代碼

jackyliu

回復 17# c_c_lai

我遇到新複製sheet的檔案超過25mb, mail發不出去...
還在想有其他方式嗎?

另外分享我的code
Sub sendmail(fs As String)
Dim CDO_Mail_Object As Object
Dim CDO_Config As Object
Dim SMTP_Config As Variant
Dim Email_Subject, Email_Send_From, Email_Send_To, Email_Cc, Email_Bcc, Email_Body As String
Email_Subject = "Today IB Bank List! (Attachment)"
Email_Send_From = "xxxx@xxx.com"
Email_Send_To = "xxx@xxxxx.com"
Email_Cc = "xxxx@xxxx.com"
Email_Bcc = "xxx@xxx.com"
Email_Body = "test "
Set CDO_Mail_Object = CreateObject("CDO.Message")
On Error GoTo debugs
Set CDO_Config = CreateObject("CDO.Configuration")
CDO_Config.Load -1
Set SMTP_Config = CDO_Config.Fields
With SMTP_Config
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'please put your server name below
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "xxxx.xxx.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With
With CDO_Mail_Object
Set .Configuration = CDO_Config
End With
CDO_Mail_Object.Subject = Email_Subject
CDO_Mail_Object.From = Email_Send_From
CDO_Mail_Object.To = Email_Send_To
CDO_Mail_Object.TextBody = Email_Body
CDO_Mail_Object.CC = Email_Cc 'Use if needed
CDO_Mail_Object.BCC = Email_Bcc 'Use if needed
CDO_Mail_Object.AddAttachment "D:\test.xls"


CDO_Mail_Object.Send
debugs:
If Err.Description <> "" Then MsgBox Err.Description
'Sheet1.Select
ThisWorkbook.Save
Application.DisplayAlerts = True
ThisWorkbook.Close
End Sub

c_c_lai

回復 18# jackyliu
妳的 SMTP Server 的 IP Address 是設定多少？

jackyliu

回復 19# c_c_lai

.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'please put your server name below
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "xxxx.xxx.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25