Nouveau classeur Excel créé par la macro Outlook n'étant pas enregistré dans le répertoire

Question

J'ai une macro Outlook qui fonctionne pour exporter les utilisateurs Tasklist vers une feuille de calcul Excel stockée sur un lecteur réseau. Je tente de vérifier si un classeur est déjà présent dans le répertoire (If statement taken form here).

S'il n'y a pas un, puis faire un nouveau classeur avec une feuille de calcul appelée « Feuille 1 », et s'il y a déjà un avec le nom d'utilisateur, puis ouvrez-le (add statement taken from here):

Merci à SO , J'ai corrigé l'erreur de nommage que j'avais, mais maintenant le worbook nouvellement créé n'est pas sauvegardé dans le répertoire. Aucune erreur n'est levée et la boîte de message à la fin de la macro s'affiche correctement. Je ne sais donc pas pourquoi le fichier n'apparaît pas dans l'Explorateur de fichiers.

Voici tout mon programme:

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 

Quelqu'un peut-il voir pourquoi le code ci-dessus ne serait pas enregistrer le fichier créé?

Answer 1

Vous devez ajouter exWb.SaveAs Filename:=FilePath A côté de exWb.Sheets("Sheet1Old").Delete

Exemple

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

vous enregistrez le classeur ici:

exWb.Save 

Si le classeur a été créé ici:

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

Ensuite, vous n'êtes pas en spécifiant le nom de fichier du classeur, donc s'il est Book1 alors vous avez très probablement un nouveau fichier Book1.xlsx dans votre Mon Documents dossier.

Et s'il y a déjà un fichier Book1.xlsx, l'instance objExcel affiche une alerte:

que je dois faire une supposition, mais ma théorie est queobjExcel est un fichier Excel instance d'application créée pour "s'exécuter en arrière-plan", elle n'est pas visible. Mais même si l'application n'est pas visible, normalement vous obtiendrez cette boîte d'alerte. Sauf que vous explicitement désactivé il:

objExcel.DisplayAlerts = False 

Avec des alertes handicapés, Save va simplement remplacer un fichier existant.

Donc vous n'obtenez pas d'erreurs, mais le fichier ne se trouve pas dans le dossier dans lequel vous l'attendiez, ni avec le nom de fichier avec lequel vous l'enregistreriez, mais est créé.

Si vous souhaitez enregistrer un fichier sous un chemin/nom de fichier spécifié, vous utilisez la méthode SaveAs au lieu de Save-but that's no news.

---

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