加载工作表时要执行的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