前面的博客介绍了Trvieww控件如何将数据导出到指定路径的excel文件，有时我们希望自己指定路径和文件名，这个就需要借助microsoft command dailog control控件。假设画面上已经有了TreeView控件，名字修改为TV，添加一个microsoft command dailog control工名字修改为CD，有一个按钮用于数据导出，按钮的鼠标点击事件添加以下vbs脚本，红色加粗部分就是与前面博客脚本不同的地方，可以看出稍作修改就能自定义保存路径了：

Sub OnClick(ByVal Item)                             
Dim LV,CD,i,j,RowCount,ColCount,Row,Col
Dim xlapp,objsheet,FileName
'选择保存路径
Set CD=screenitems("CD")
CD.Filter="*.xlsx|*.xlsx"
CD.FilterIndex=2
CD.ShowOpen
FileName=CD.FileName
If Filename="" Then
    Msgbox "未写入任何文件名"
 Exit Sub 
End If

Set LV=ScreenItems("LV")
RowCount=LV.listitems.count 'LV的行数
ColCount=LV.ColumnHeaders.Count  'LV的列数
Set xlapp=CreateObject("Excel.Application")
xlapp.visible=False
xlapp.workbooks.add
Set objsheet=xlapp.worksheets(1)

'添加列标题
For i=2 To ColCount
 objsheet.cells(3,i-1)=LV.ColumnHeaders.Item(i).Text
Next

'报表标题
objsheet.cells(1,1)="用户归档表"
'Msgbox LV.ListItems.item(1).listsubitems.item(2)
'填充数据
For i=1 To RowCount    '行的序号是从1开始的
 For j=1 To ColCount-1 '列的序号是从0开始的
  Row=3+i
  Col=j
  'Msgbox LV.ListItems.item(i).listsubitems.item(j)
  objsheet.cells(Row,Col)=CStr(LV.ListItems.item(i).listsubitems.item(j))
  'objsheet.cells(4,1)=CStr(LV.ListItems.item(1).listsubitems.item(2))
 Next
Next
'单元格边框线
objsheet.range("a1:d1").mergecells=True  '合并单元格
objsheet.range("b3").ColumnWidth =20
objsheet.range("c3").ColumnWidth =20
objsheet.cells(2,1)="生成时间："
objsheet.cells(2,2)=Year(Now) & "年" & Month(Now) & "月" & Day(Now) & "日"
objsheet.cells(1,1).HorizontalAlignment = 3
objsheet.range("a3:d" & CStr(3+RowCount)).borders(1).linestyle=9
objsheet.range("a3:d" & CStr(3+RowCount)).borders(1).weight=2
objsheet.range("a3:d" & CStr(3+RowCount)).borders(2).linestyle=9
objsheet.range("a3:d" & CStr(3+RowCount)).borders(2).weight=2
objsheet.range("a3:d" & CStr(3+RowCount)).borders(3).linestyle=9
objsheet.range("a3:d" & CStr(3+RowCount)).borders(3).weight=2
objsheet.range("a3:d" & CStr(3+RowCount)).borders(4).linestyle=9
objsheet.range("a3:d" & CStr(3+RowCount)).borders(4).weight=2

'保存文件
xlapp.Activeworkbook.saveas (filename)
xlapp.workbooks.close
xlapp.quit
Msgbox "成功导出到C:\"

End Sub

保存运行，就能实现想要的效果了。