由Outlookmacros创build的新Excel工作簿不保存在目录中

我有一个Outlookmacros，它将用户Tasklist导出到存储在networking驱动器上的Excel电子表格中。

我试图检查目录中是否已经存在工作簿（ 如果在此处采用语句 ）。

如果没有，那么用一张名为“Sheet 1”的工作表创build一个新的工作簿，如果已经有一个正确的用户名，那么将其打开（ 从这里添加语句 ）：

由于这样，我有propery修正了我有的命名错误，但现在新创build的小册子没有被保存在目录文件夹。 没有错误被抛出，并在macros结束msg框被正确显示，所以我不知道为什么该文件不显示在文件资源pipe理器中。

这是我的整个计划：

 Sub Task_Grab_V2() Dim sKillExcel As String Dim strReport As String Dim olnameSpace As Outlook.NameSpace Dim taskFolder As Outlook.MAPIFolder Dim tasks As Outlook.Items Dim tsk As Outlook.TaskItem Dim objExcel As New Excel.Application Dim exWb As Excel.Workbook Dim sht As Excel.Worksheet Dim NAME_s As String Dim Range As Excel.Range Dim str As String, strClean As String Dim z As Integer Dim strMyName As String Dim x As Integer Dim y As Integer Dim stat_string As String Dim r As Range, s As String, iloc As Long Dim s1 As String, cell As Range, col As Long Dim sChar As String Dim strUserName As String objExcel.DisplayAlerts = False 'Use the Application Object to get the Username NAME_s = Environ("USERNAME") Dim FilePath As String Dim TestStr As String FilePath = "some\directory" & NAME_s & ".xlsx" TestStr = "" On Error Resume Next TestStr = Dir(FilePath) On Error GoTo 0 If TestStr = "" Then Set exWb = objExcel.Workbooks.Add(1) exWb.Sheets("Sheet1").Name = "Sheet1Old" exWb.Sheets.Add().Name = "Sheet1" exWb.Sheets("Sheet1Old").Delete Else Set exWb = objExcel.Workbooks.Open("some\directory" & NAME_s & ".xlsx") exWb.Sheets.Add().Name = "Sheet1" exWb.Sheets("Sheet1_old").Delete End If Set olnameSpace = Application.GetNamespace("MAPI") Set taskFolder = olnameSpace.GetDefaultFolder(olFolderTasks) Set tasks = taskFolder.Items strReport = "" 'Create Header exWb.Sheets("Sheet1").Cells(1, 1) = "Subject" exWb.Sheets("Sheet1").Cells(1, 2) = "Category" exWb.Sheets("Sheet1").Cells(1, 3) = "Due Date" exWb.Sheets("Sheet1").Cells(1, 4) = "Percent Complete" exWb.Sheets("Sheet1").Cells(1, 5) = "Status" exWb.Sheets("Sheet1").Cells(1, 6) = "Notes" y = 2 For x = 1 To tasks.Count Set tsk = tasks.Item(x) 'strReport = strReport + tsk.Subject + "; " 'Fill in Data If Not tsk.Complete Then If tsk.Status = olTaskDeferred Then stat_string = "Deferred" End If If tsk.Status = olTaskInProgress Then stat_string = "In Progress" End If If tsk.Status = olTaskNotStarted Then stat_string = "Not Started" End If If tsk.Status = olTaskWaiting Then stat_string = "Waiting on Someone Else" End If exWb.Sheets("Sheet1").Cells(y, 1) = tsk.Subject exWb.Sheets("Sheet1").Cells(y, 2) = tsk.Categories exWb.Sheets("Sheet1").Cells(y, 3) = tsk.DueDate exWb.Sheets("Sheet1").Cells(y, 4) = tsk.PercentComplete exWb.Sheets("Sheet1").Cells(y, 5) = stat_string exWb.Sheets("Sheet1").Cells(y, 6) = tsk.Body 'the following section searches the body of the task for a specified character and deletes everything after it col = 6 ' assumes column 6, change to your column sChar = "#" ' assume character to look for is hash, change to yours With objExcel.ActiveSheet Set r = .Range(.Cells(2, col), .Cells(.Rows.Count, col).End(xlUp)) End With For Each cell In r s = cell.Text If Len(Trim(s)) > 0 Then iloc = InStr(1, s, sChar, vbTextCompare) If iloc > 1 Then s1 = Left(s, iloc - 1) cell.Value = s1 Else If iloc <> 0 Then cell.ClearContents End If End If End If Next cell y = y + 1 stat_string = "" End If Next x 'Autofit all column widths On Error Resume Next For Each sht In objExcel.ActiveWorkbook.Worksheets sht.Columns("A").EntireColumn.AutoFit sht.Columns("B").EntireColumn.AutoFit sht.Columns("C").EntireColumn.AutoFit sht.Columns("D").EntireColumn.AutoFit sht.Columns("E").EntireColumn.AutoFit sht.Columns("F").EntireColumn.AutoFit Next sht exWb.Save exWb.Close Set exWb = Nothing 'this kills the excel program from the task manager so the code will not double up on opening the application sKillExcel = "TASKKILL /F /IM Excel.exe" Shell sKillExcel, vbHide MsgBox ("Tasks have been sucessfully exported.") End Sub 

任何人都可以看到为什么上面的代码不会保存创build的文件？

Answer 1

您需要添加exWb.SaveAs Filename:=FilePath旁边exWb.Sheets("Sheet1Old").Delete

例

  Set exWb = objExcel.Workbooks.Add(1) exWb.Sheets("Sheet1").Name = "Sheet1Old" exWb.Sheets.Add().Name = "Sheet1" exWb.Sheets("Sheet1Old").Delete exWb.SaveAs FileName:=FilePath 

Answer 2

你在这里保存工作簿：

 exWb.Save 

如果工作簿是在这里创build的：

 If TestStr = "" Then Set exWb = objExcel.Workbooks.Add(1) 

那么你没有指定工作簿的文件名，所以如果它是Book1那么你的“ 我的文档”文件夹中很可能有一个新的Book1.xlsx文件。

如果已经有一个Book1.xlsx文件， objExcel实例会popup一个警告：

我需要在这里做一个假设，但我的理论是， ¹ objExcel是一个Excel应用程序实例，创build“在后台运行”，它不可见。 但即使该应用程序不可见， 通常您会看到该警报框。 除了你明确禁用它：

 objExcel.DisplayAlerts = False 

警报被禁用时， Save将只覆盖现有的文件。

所以你没有错误，但是这个文件不在你期望的文件夹中，也不在你要保存的文件名中，但是它被创build。

如果要将文件保存在指定的path/文件名下 ，则使用SaveAs方法而不是Save – 但这不是新闻 。

---

_{¹ 它刚刚宣布为Dim objExcel As New Excel.Application。 – scb998 2分钟前}