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

jackyliu

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

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

jackyliu

回復 25# stillfish00

原本測試檔案, Run起來沒問題; 後來我將code 轉到其他檔案上(四個sheet裡,共有六個樞紐資料,總共有28MB),
程式跑起來,就出問題,附上相關圖片...

下載 (24.32 KB)

2013-8-30 22:49

下載 (11.62 KB)

2013-8-30 22:49

下載 (23.53 KB)

2013-8-30 22:49

大大: 有其他的方法嗎?能讓我mail出去嗎? 目前我都人工方式,將樞紐資料圈選後,
在到Outlook 操作 選擇性貼上..點陣圖 ,再mail 出去 ~ 能夠自動化嗎?

stillfish00

回復 21# jackyliu

1. Sub RangeToPicture()
   
2.   Dim rngSrc As Range
   
3.    
   
4.   With ActiveSheet
   
5.     Set rngSrc = .UsedRange
   
6.    
   
7.     rngSrc.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
   
8.     With .ChartObjects.Add(Left:=rngSrc.Left, Top:=rngSrc.Top, Width:=rngSrc.Width, Height:=rngSrc.Height)
   
9.       .Chart.Paste
   
10.       .Chart.Export "C:\pic1.jpg"
    
11.       .Delete
    
12.     End With
    
13.   End With
    
14. End Sub

複製代碼

jackyliu

回復 23# Hsieh

主要是將execl檔案裡的四個sheet 內容, 用Outlook  mail方式寄出(自動化)
目前是人工手動開啟execl檔案 , 將四個sheet 內容 用 cut圖軟體, 複製貼到 Outlook  mail方式寄出,
希望 能有辦法,用vba處理.

這要看資料範圍大小而定，若無法完整顯示資料區域那將無法取得完整畫面
回覆:  1. sheet+範圍 複製貼到 Outlook  mail方式寄出
          2. 直接將四個sheet , 複製貼到 Outlook  mail方式寄出
以上兩種作法,哪個做的出來?

Hsieh

回復 21# jackyliu
工作表要存成圖檔?
這要看資料範圍大小而定，若無法完整顯示資料區域那將無法取得完整畫面

jackyliu

回復 6# GBKEE


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

最終結果如圖片所示: 將execl檔案裡的四個sheet 複製另存成圖檔,並mail 出去...
附件就是outlook 寄出畫面，希望大家能夠幫忙和分享,感謝!

jackyliu

回復 4# Hsieh

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

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

c_c_lai

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

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