加載工作表時要執行的Excel VBA代碼

Question

我完全不是這些問題的專家，但我有一個Excel工作表，我希望通過電子郵件自動生成並每天發送。現在，Excel中的值將從數據庫更新，因此已經完成。我的桌面上有工作表。我想在Windows Vista中使用Task Scheduler，但不確定這是否是正確的做法。

我需要打開表格......更新...然後通過電子郵件發送到xxxx @ xxx更新版本 任何想法或提示如何做到這一點？ 我有斷網，併發送電子郵件的工作原理的代碼是：

Sub Mail_ActiveSheet() 
'Working in 97-2010 
Dim FileExtStr As String 
Dim FileFormatNum As Long 
Dim Sourcewb As Workbook 
Dim Destwb As Workbook 
Dim TempFilePath As String 
Dim TempFileName As String 
Dim I As Long 

With Application 
    .ScreenUpdating = False 
    .EnableEvents = False 
End With 

Set Sourcewb = ActiveWorkbook 

'Copy the sheet to a new workbook 
ActiveSheet.Copy 
Set Destwb = ActiveWorkbook 

'Determine the Excel version and file extension/format 
With Destwb 
    If Val(Application.Version) < 12 Then 
     'You use Excel 97-2003 
     FileExtStr = ".xls": FileFormatNum = -4143 
    Else 
     'You use Excel 2007-2010, we exit the sub when your answer is 
     'NO in the security dialog that you only see when you copy 
     'an sheet from a xlsm file with macro's disabled. 
     If Sourcewb.Name = .Name Then 
      With Application 
       .ScreenUpdating = True 
       .EnableEvents = True 
      End With 
      MsgBox "Your answer is NO in the security dialog" 
      Exit Sub 
     Else 
      Select Case Sourcewb.FileFormat 
      Case 51: FileExtStr = ".xlsx": FileFormatNum = 51 
      Case 52: 
       If .HasVBProject Then 
        FileExtStr = ".xlsm": FileFormatNum = 52 
       Else 
        FileExtStr = ".xlsx": FileFormatNum = 51 
       End If 
      Case 56: FileExtStr = ".xls": FileFormatNum = 56 
      Case Else: FileExtStr = ".xlsb": FileFormatNum = 50 
      End Select 
     End If 
    End If 
End With 

' 'Change all cells in the worksheet to values if you want 
' With Destwb.Sheets(1).UsedRange 
'  .Cells.Copy 
'  .Cells.PasteSpecial xlPasteValues 
'  .Cells(1).Select 
' End With 
' Application.CutCopyMode = False 

'Save the new workbook/Mail it/Delete it 
TempFilePath = Environ$("temp") & "\" 
TempFileName = "Part of " & Sourcewb.Name & " " _ 
      & Format(Now, "dd-mmm-yy h-mm-ss") 

With Destwb 
    .SaveAs TempFilePath & TempFileName & FileExtStr, _ 
      FileFormat:=FileFormatNum 
    On Error Resume Next 
    For I = 1 To 3 
     .SendMail "dsdsdsd@hotmail.com", _ 
        "dsds,dsd, dsdsdsds report" 
     If Err.Number = 0 Then Exit For 
    Next I 
    On Error GoTo 0 
    .Close SaveChanges:=False 
End With 

'Delete the file you have send 
Kill TempFilePath & TempFileName & FileExtStr 

With Application 
    .ScreenUpdating = True 
    .EnableEvents = True 
End With 
End Sub 

Answer 1

1. 保存經由如NotePad一個文本編輯器如vbs，像「myscript.vbs」下面的代碼。 注意這不是VBA
2. 從How to use the Windows Task Scheduler使用說明如果您的電子郵件是通過Outlook使用clickyes交付繞過前景的警告。（調度VBS
3. 如果你確認這一點，我將進一步增加自動化代碼強制發送/收到

請更改路徑，這裏
strWB = "C:\temp\test.xls"

您的桌面文件中的一些代碼appeare的d冗餘，即保存和查殺文件無關緊要，因爲SendMail直接工作（而使用Outlook則需要添加保存的附件）。該文件版本並沒有出現增加值要麼

Dim objExcel 
    Dim objOutlook 
    Dim objWB 
    Dim objws 
    Dim strWB 
    Dim strWB2 
    'Change file path to be emailed 
    strWB = "C:\temp\test.xls" 
    Set objExcel = CreateObject("Excel.Application") 
    objExcel.DisplayAlerts = False 
    Set objWB = objExcel.Workbooks.Open(strWB) 
    'Change sheet index as needed 
    Set objws = objWB.Sheets(1) 
    objws.Copy 
    With objExcel.ActiveWorkbook 
     .SendMail "brt@notmyemail.net.au", "test" 
     .Close False 
    End With 
    objWB.Close False 
    With objExcel 
     .DisplayAlerts = True 
     .Quit 
    End With