vba靈活調用shell及vba FSO對文件的操作

1、強製改變當前的驅動器：　ChDrive "E"
2、強製改變默認的工作目録：chdir "E:/"
完成以上動作之後，再來調用E：/的批處理文件：shell "e:/234.bat"
這樣執行的效果就和DOS下執行的效果一緻。
原因在哪？這是因爲SHELL的工作切入點是在Application的默認工作目録中，也就是説，除非在批處理中強行界定目標路徑，否則，SHELL執行批處理時永遠都是Application的默認工作目録下進行。
而Application的默認工作目録一般都是“我的文檔”。你可以這樣試驗一下，在E：/創建一箇批處理234.bat，內容是　dir >123.inf ，就是將dir列錶寫進到123.inf文件中，然後在立卽窗口中shell "E:/234.bat" ，之後再用windows的搜索功能，搜索一下剛剛生成的123.inf文件，你就會髮現這箇文件是在“我的文檔”中，而不是在E：/下，而在DOS下直接執行234.bat，則結果文件就自然在E:/下。
如果是在立卽窗口中，依次執行
ChDrive "E"
chdir "E:/"
shell "e:/234.bat"
你再看一下，生成的文件就在E：/下瞭。

Option Explicit

'version 0.1 2009/08/05 add Attached_SaveAs

Sub Attached_SaveAs()

'執行前，在工具，引用中加入"Microsoft   Scripting   Runtime"
Dim fso As New FileSystemObject
Dim fldr As Folder
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists("d:/GDS_HUB_Report_Used_by_Rita") Then             '判斷是否存在這箇文件夾
fso.DeleteFolder ("d:/GDS_HUB_Report_Used_by_Rita")
Else
MsgBox "program will create a new Folder which is named 'GDS_HUB_Report_Used_by_Rita' on the D disk!"
End If
MkDir "D:/GDS_HUB_Report_Used_by_Rita"
'Shell "D:/", 0
'Shell "cd 1", 1

'調用shell命令前加入改變當前默認路徑
ChDrive "D"
ChDir "D:/1/"
Shell "calc.exe", 1
Shell "C:/Program Files/7-zip/7z.exe e d:/1/1.rar", 1
Dim myOlSel As Outlook.Selection
Dim j, x, cu As Integer
Dim strFolder As String
Dim defaultPath As String
Dim YN As Integer, zipYN As Integer
Dim i As Long
Dim oApp As Object
Set oApp = CreateObject("Shell.Application")
Set myOlSel = Application.ActiveExplorer.Selection
defaultPath = "D:/GDS_HUB_Report_Used_by_Rita/"
If FileExist("C:/VBAtemp.ini") Then
Open "c:/VBAtemp.ini" For Input As #1
Line Input #1, defaultPath
Close #1
If PathExist(defaultPath) Then
YN = MsgBox(defaultPath, vbYesNo, "Save file to this path ?")
If YN = vbNo Then
strFolder = getFOLDER()
Else
strFolder = defaultPath
End If
Else
strFolder = getFOLDER()
End If
Else
strFolder = getFOLDER()
End If
zipYN = MsgBox("auto unzip ?", vbYesNo, "auto unzip ?")

For x = 1 To myOlSel.Count
With myOlSel.Item(x)
cu = 0
cu = .Attachments.Count

If cu > 0 Then
For j = 1 To cu
On Error Resume Next

If FileExist(strFolder & "/" & .Attachments(j).DisplayName) Then
.Attachments(j).SaveAsFile (strFolder & "/" & .Attachments(j).DisplayName & "_double" & i)
If FileDateTime(strFolder & "/" & .Attachments(j).DisplayName) > FileDateTime(strFolder & "/" & .Attachments(j).DisplayName & "_double") Then
Kill strFolder & "/" & .Attachments(j).DisplayName & "_double"
Else
Kill strFolder & "/" & .Attachments(j).DisplayName
Name strFolder & "/" & .Attachments(j).DisplayName & "_double" As strFolder & "/" & .Attachments(j).DisplayName
End If
Else
.Attachments(j).SaveAsFile (strFolder & "/" & .Attachments(j).DisplayName)
i = i + 1
End If
'                    If FileExist(strFolder & "/" & .Attachments(j).DisplayName) Then
'                        i = i + 1
'                    End If
If zipYN = vbYes Then
If UCase(Right(strFolder & "/" & .Attachments(j).DisplayName, 3)) = "ZIP" Or UCase(Right(strFolder & "/" & .Attachments(j).DisplayName, 3)) = "RAR" Then
oApp.NameSpace(strFolder & "/").CopyHere oApp.NameSpace(strFolder & "/" & .Attachments(j).DisplayName).Items
End If
End If
Next
End If

End With
Next
MsgBox "Success save " & i & " files", vbOKOnly, "complete"
End Sub

Function getFOLDER() As String
Dim objShell As Object  'Shell
Dim objFolder As Object 'Shell32.Folder
Dim objFolderItem As Object

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.NameSpace(0)
Set objFolderItem = objFolder.Self

Set objFolder = objShell.BrowseForFolder(0, "Select a folder:", 0, 0)

If objFolder Is Nothing Then
getFOLDER = "Cancel"
Else
If objFolder.ParentFolder Is Nothing Then
getFOLDER = "C:/Documents and Settings/" & Environ("username") & "/" & objFolder
Else
getFOLDER = objFolder.Items.Item.Path
End If
End If

Set objFolder = Nothing
Set objShell = Nothing

If getFOLDER <> "Cancel" Then
Open "c:/VBAtemp.ini" For Output As #1
Print #1, getFOLDER
Close #1
End If
End Function

Function FileExist(rFile As String) As Boolean
Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")
FileExist = fs.FileExists(rFile)
End Function

Private Function PathExist(pname) As Boolean
Dim x As String
On Error Resume Next
x = GetAttr(pname) And 0
If Err = 0 Then PathExist = True _
Else PathExist = False
End Function