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.