返回列表 上一主題 發帖

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

回復  GBKEE

檢查一下工作表的名稱 "TEST", "RAW", "TODAY","YESDAY","NOW"是否有誤!
有"TEST "," TES ...
jackyliu 發表於 2013-8-28 14:47
  1. Sub Copy_Sheet()
  2.     Sheets(Array("TEST", "RAW", "TODAY", "YESDAY", "NOW")).Copy   '  同時複製 "TEST"、以及 "RAW" 等五個工作表單
  3.     fs = ThisWorkbook.Path & "\" & Format(Date, "yyyy_mm_dd") & ".xls"      '  存檔檔名
  4.     ActiveWorkbook.SaveAs FileName:=fs, FileFormat:=-4143
  5. End Sub
複製代碼
這語法是正確的,GBKEE版大用的是 2003,而我是使用 2010,
請檢查妳的程式碼。

TOP

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

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

TOP

回復 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    [email protected]
  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.     strSch = "http://schemas.microsoft.com/cdo/configuration/"
  17.     Set objCDOConfig = CreateObject("CDO.Configuration")
  18.     With objCDOConfig.Fields
  19.         .Item(strSch & "sendusing") = cdoSendUsingPort
  20.         .Item(strSch & "smtpserver") = "SMTP.ServerName.Com"
  21.         ' Only used if SMTP server requires Authentication
  22.         .Item(strSch & "smtpauthenticate") = cdoBasic
  23.         .Item(strSch & "sendusername") = "[email protected]"
  24.         .Item(strSch & "sendpassword") = "YourPassword"
  25.         .Update
  26.     End With

  27.     Set objCDOMessage = CreateObject("CDO.Message")
  28.     With objCDOMessage
  29.         Set .Configuration = objCDOConfig
  30.         .from = "Senders Pretty Name"
  31.         .sender = "[email protected]"
  32.         .To = "[email protected]"
  33.         .Subject = "Sample CDO Message"
  34.         ' Use TextBody to send Email in Plain Text Format
  35.         '.TextBody = "This is a test for CDO message"
  36.         ' Use HTMLBody to send Email in Rich Text (HTML) Format
  37.         .HTMLBody = "Test CDO Rich Text this is not Bold But <B>This is!</B>"
  38.         ' Adding Attachments is easy enough
  39.         .AddAttachment "c:\SomeFile.zip"
  40.         .AddAttachment "c:\SomeOtherFile.pdf"
  41.         ' Un-Rem next line to get "Return Reciept Request"
  42.         '.MDNRequested = True
  43.         .Send
  44.     End With
  45.     Set objCDOMessage = Nothing
  46.     Set objCDOConfig = Nothing
  47. End Sub
複製代碼

TOP

回復 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. Sub sendmail(fs As String)
  8.    CDO_Mail_Object.AddAttachment fs
  9.     CDO_Mail_Object.Send
  10. End Sub
複製代碼

TOP

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

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

TOP

回復 14# jackyliu
再修正後連結產生的訊息:(已經加入cdoSendUsingPort 等參數)
關鍵性應是無法正確連結 SMTP Server。
  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.     strSch = "http://schemas.microsoft.com/cdo/configuration/"
  8.     Set objEmail = CreateObject("CDO.Message")       '  建立 CDO 物件
  9.    
  10.     On Error GoTo debugErr
  11.     Set CDO_Config = CreateObject("CDO.Configuration")
  12.     With CDO_Config.Fields
  13.         .Item(strSch & "sendusing") = cdoSendUsingPort
  14.         .Item(strSch & "smtpserver") = "SMTP.ServerName.Com"
  15.         ' Only used if SMTP server requires Authentication
  16.         .Item(strSch & "smtpauthenticate") = cdoBasic
  17.         .Item(strSch & "sendusername") = "[email protected]"
  18.         .Item(strSch & "sendpassword") = ""
  19.         .Update
  20.     End With

  21.     With objEmail
  22.         Set .Configuration = CDO_Config

  23.         .From = "[email protected]"               '  寄件者(網域必須存在)
  24.         .To = "[email protected]"                 '  收件者
  25.         .Subject = "CDO郵件測試"                    '  郵件主旨
  26.         .TextBody = "郵件測試本文"                 '  郵件內文
  27.    
  28.         .AddAttachment fd
  29.         .Send
  30.     End With
  31.    
  32. debugErr:
  33.     If Err.Description <> "" Then MsgBox Err.Description
  34.     Set objEmail = Nothing
  35.     Set CDO_Config = Nothing
  36. End Sub
複製代碼

TOP

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

TOP

        靜思自在 : 君子為目標,小人為目的。
返回列表 上一主題