VBA shell call and VBA File Operations

Source: Internet
Author: User

Before calling shell, you must follow these steps: (perform operations in the E: disk root directory as an example)
1. force change the current drive: chdrive "e"
2. force change the default working directory: chdir "E :/"
After completing the preceding operations, call the batch processing file E:/: shell "E:/234.bat"
In this way, the execution effect is the same as that in DOS.

Why? This is because the shell work start point is in the default working directory of the application, that is, unless the target path is defined in the batch processing, the shell always performs batch processing in the default working directory of the application.
The default working directory of application is generally "My documents ". You can try to create a batch processing 234.batin E:/. The content is dir> 123.inf, which is to write the Dir list to 123. in the INF file, and then shell "E:/234.bat" in the immediate window, and then use the Windows Search function to search for the generated 123. INF file, you will find that this file is in "My Document", rather than under E:/, and directly execute 234.batin dos, The result file is naturally in E:.
In the immediate window, execute
Chdrive "e"
Chdir "E :/"
Shell "E:/234.bat"
Let's take a look at the generated file in E.

 

Option explicit

'Version 0.1 2009/08/05 add attached_saveas

Sub attached_saveas ()

'Add "Microsoft scripting RunTime" to the tool and reference before execution"
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 ', check whether the folder exists.
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

'Add and change the current default path before calling the shell command
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
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

 

Related Article

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.