Hi there,
Below is the macro that I am using to export tasks from Outlook into Excel. I put it together after Googling for bits of macro.
What I'd like to do is have the ability to open up a "Save As" dialogue box to allow the user to specify where the excel file is to be saved (instead of having the user manually enter the address).
Macro 1. Exports tasks from Outlook into excel:
Code
Sub ExportTasks()
MsgBox "Make sure Outlook is Open.", vbOKOnly, "Task Exporter"
Dim Ns As Outlook.NameSpace
Set Ns = Application.GetNamespace("MAPI")
'use the default folder
Set Items = Ns.GetDefaultFolder(olFolderTasks).Items
Const SCRIPT_NAME = "Export Tasks to Excel"
Dim olkTsk As Object, _
excApp As Object, _
excWkb As Object, _
excWks As Object, _
lngRow As Long, _
lngCnt As Long, _
strFilename As String
'manually enter full file address
strFilename = InputBox("Enter a filename (including path) to save the exported tasks to.", SCRIPT_NAME)
If strFilename = "" Then
MsgBox "The filename is blank. Export aborted.", vbInformation + vbOKOnly, SCRIPT_NAME
Else
Set excApp = CreateObject("Excel.Application")
Set excWkb = excApp.Workbooks.Add()
Set excWks = excWkb.ActiveSheet
' Excel Column Headers
With excWks
.Cells(1, 1) = "Subject"
.Cells(1, 2) = "StartDate"
.Cells(1, 3) = "DueDate"
End With
lngRow = 2
For Each olkTsk In Ns.GetDefaultFolder(olFolderTasks).Items 'Get data from tasks folder in outlook
excWks.Cells(lngRow, 1) = olkTsk.Subject
excWks.Cells(lngRow, 2) = olkTsk.StartDate
excWks.Cells(lngRow, 3) = olkTsk.DueDate
lngRow = lngRow + 1
lngCnt = lngCnt + 1
Next
Set olkTsk = Nothing
excWkb.saveas strFilename
excWkb.Close
MsgBox "Process complete. A total of " & lngCnt & " tasks were exported.", vbInformation + vbOKOnly, SCRIPT_NAME
End If
Set excWks = Nothing
Set excWkb = Nothing
Set excApp = Nothing
End Sub
Display More
Macro 2: Opens Up "Save As"
I am trying to merge the macro below into the macro above. However I can't seem to get it right
Code
Sub SaveAsDialog()
Dim sFolderName As String, fDialog As FileDialog, ret As Long, FileToSave As String, vrtSelectedItems
Set fDialog = Application.FileDialog(msoFileDialogSaveAs)
fDialog.InitialFileName = "test"
ret = fDialog.Show
With Application.FileDialog(msoFileDialogSaveAs)
For Each vrtSelectedItem In .SelectedItems
FileToSave = vrtSelectedItem
ActiveWorkbook.SaveAs FileToSave
Next vrtSelectedItem
End With
End Sub
[B]
Display More
[/B]