Home > Mobile >  How to suppress "File already exists" prompt when overwriting?
How to suppress "File already exists" prompt when overwriting?

Time:01-01

I am using a script to download my Outlook calendar in Excel format to my hard drive. Every time I use it I get a prompt saying that the file already exists as the previously downloaded file is still there.

Is there a way to suppress this prompt? I want to overwrite without having to manually click yes.

Sub calendar_download()

    Dim myNameSpace As Outlook.NameSpace
    Dim tdystart As Date
    Dim tdyend As Date
    Dim myAppointments As Outlook.Items
    Dim currentAppointment As Outlook.AppointmentItem
    Dim xlApp As Object
    Dim xlWorkbook As Object
    Dim xlWorksheet As Object
    Dim i As Long
    
    Set xlApp = CreateObject("Excel.Application")
    Set xlWorkbook = xlApp.Workbooks.Add
    Set xlWorksheet = xlWorkbook.Worksheets(1)

    With xlWorksheet
        .Cells(1, 1).Value = "Body"
        .Cells(1, 2).Value = "Start"
        .Cells(1, 3).Value = "End"
        .Cells(1, 4).Value = "Subject"
    End With
    
    Set myNameSpace = Application.GetNamespace("MAPI")
    
    tdystart = VBA.Format(Now, "Short Date")
    tdyend = VBA.Format(Now   1, "Short Date")
 
    Set myAppointments = myNameSpace.GetDefaultFolder(olFolderCalendar).Items
 
    myAppointments.Sort "[Start]"
 
    myAppointments.IncludeRecurrences = True
 
    Set currentAppointment = myAppointments.Find("[Start] >= """ & tdystart & """ and [Start] <= """ & tdyend & """")
    i = 2
    While TypeName(currentAppointment) <> "Nothing"
        Debug.Print currentAppointment.Subject
        xlWorksheet.Cells(i, 1).Value = currentAppointment.Body
        xlWorksheet.Cells(i, 2).Value = currentAppointment.Start
        xlWorksheet.Cells(i, 3).Value = currentAppointment.End
         xlWorksheet.Cells(i, 4).Value = currentAppointment.Subject
        i = i   1

        Set currentAppointment = myAppointments.FindNext
    Wend
    
    xlWorksheet.Columns("A:D").EntireColumn.AutoFit
    xlWorkbook.SaveAs "C:\calendar\Calendardownload.xlsx" ' <------- Change this Path to the location you want to save the file to
    xlWorkbook.Close

End Sub

CodePudding user response:

You can delete the existing file before saving. Insert the following lines before xlWorkbook.SaveAs ...:

  If Len(Dir("C:\calendar\Calendardownload.xlsx")) <> 0 Then
      Kill "C:\calendar\Calendardownload.xlsx"
  End If

It will first test if the file exists.

  • Related