vba调用linux shell,vba shell 调用和vba 文件操作

在调用SHELL之前，必须要通过以下步骤：(以在E：盘根目录下操作为例)

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