access其最大的优点是：简单易学！非计算机专业的人员，也能学会。所以用它作为数据库的入门来学习是非常不错的选择。本文主要讲诉怎样一步步搭建一个小型的ACCESS数据库今天在确认实习......
vba灵活调用shell及vba FSO对文件的操作
Access
2021-09-18 09:11:50
在调用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
相关文章
- 详细阅读
- 详细阅读
- 详细阅读
-
Access2016数据库开发教程1详细阅读
第一章开发平台概述1.1盟威软件快速开发平台是什么?1.1.1概述《盟威软件快速开发平台(Access版)》是一款免费的快速开发平台。该平台主要用于企业中各种管理信息系统的开发，不会编程的......
2022-04-19 488 Access Access2016 Access2016数据库开发 数据库开发
- 详细阅读
