返回列表 上一主題 發帖

[發問] 檔案中的兩個Sheet 複製到新的檔案問題

[發問] 檔案中的兩個Sheet 複製到新的檔案問題

目的:A檔案(test01.xls)的樞紐整理完畢後,將A檔案的其中幾個Sheets(TEST、RAW;TEMP不要COPY)內容複製到B檔案儲存,並依儲存日期時間命名.

目前VBA內容已有 1.檔案命名, 2.A檔案的Sheets複製會新增一個Execl檔案,後續動作,一直試不出來,無言,麻煩版大幫忙了

目的:A檔案(test01.xls)的樞紐整理完畢後,將A檔案的其中幾個Sheets(TEST、RAW;TEMP不要COPY)內容複製到B檔案 ...
jackyliu 發表於 2013-8-26 21:22


補上檔案...

test01.rar (20.62 KB)

test01.rar (20.62 KB)

TOP

回復 4# Hsieh
我將code 轉修改到其他檔案 , 有些檔案有五個sheet 要轉存到新的檔案,
且sheet 不連續; 我用您的方式,將其他 sheet名稱加入到 Sheets(Array("TEST", "RAW", "TODAY","YESDAY","NOW")).Copy , 這樣會出現錯誤耶 !

TOP

回復 6# GBKEE

檢查一下工作表的名稱 "TEST", "RAW", "TODAY","YESDAY","NOW"是否有誤!
有"TEST "," TEST" 這情況嗎?
回覆GBKEE: 檢查一下,應該沒錯,  Sheets(Array("TEST", "RAW", "TODAY","YESDAY","NOW")).Copy ,好像只能複製兩個sheet,
三個以上就不行了 !


順道一提,依日期時間產生的檔案,要如何mail出去,
我之前都是一直指定同一個檔案,但目前做法是要將
剛才產生的mail出去,可否指導一下 !

CDO_Mail_Object.AddAttachment "D:\TEMP\test.xls"

TOP

回復 8# GBKEE
回覆GBKEE: 重新在檢查測試其他檔案,都不行複製三個以上的sheet!  Sheets(Array("TEST", "RAW", "TODAY","YESDAY","NOW")).Copy ,

TOP

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

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

TOP

回復 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

以上, 請板大協助 !

TOP

回復 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 = "[email protected]"
Email_Send_To = "[email protected]"
Email_Cc = "[email protected]"
Email_Bcc = "[email protected]"
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

TOP

回復 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

TOP

回復 4# Hsieh

有辦法將execl 的四個sheet 複製另存成圖檔嗎?
有解嗎?

TOP

        靜思自在 : 地上種了菜,就不易長草;心中有善,就不易生惡。
返回列表 上一主題