excel - 由 Outlook 宏创建的新 Excel 工作簿未保存在目录中

Question

我有一个 Outlook 宏，可以将用户任务列表导出到存储在网络驱动器上的 Excel 电子表格。

我正在尝试检查目录 ( If statement taken form here ) 中是否已存在工作簿。

如果没有，则创建一个新工作簿，其中包含一个名为“工作表 1”的工作表，如果已有一个具有正确用户名的工作簿，则将其打开 ( add statement taken from here ):

感谢SO ，我已经正确修复了我遇到的命名错误，但现在新创建的工作簿没有保存在目录文件夹中。没有抛出任何错误，并且宏末尾的消息框正确显示，因此我不知道为什么该文件没有显示在文件资源管理器中。

这是我的整个程序:

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

有人能明白为什么上面的代码不会保存创建的文件吗？

Answer 1

您正在此处保存工作簿:

exWb.Save

如果工作簿是在此处创建的:

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

那么您没有指定工作簿的文件名，因此如果它是 Book1，那么您的我的文档<中很可能有一个新的 Book1.xlsx 文件/em> 文件夹。

如果已经存在 Book1.xlsx 文件，objExcel 实例会弹出警报:

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

objExcel.DisplayAlerts = False

禁用警报后，保存将仅覆盖现有文件。

因此，您不会遇到任何错误，但该文件不在您期望的文件夹中，也不具有您保存它的文件名，但它已创建。

如果您想将文件保存在指定路径/​​文件名下，请使用SaveAs方法而不是Save - but that's no news .

<小时/>

_{¹ its just declared as Dim objExcel As New Excel.Application. – scb998 2 mins ago}