VBA文件及文件夹操作

格式：doc
大小：74.00 KB
文档页数：18

Excel：VBA 文件及文件夹操作

2011年06月12日星期日 09:08

VBA文件及文件夹操作

1.VBA操作文件及文件夹

on error resume next下测试

A，在D：\下新建文件夹，命名为folder

方法1：MkDir "D：\folder"

方法2：Set abc = CreateObject("Scripting.FileSystemObject")

abc.CreateFolder ("D：\folder")

B，新建2个文件命名为a.xls和b.xls

Workbooks.Add

ActiveWorkbook.SaveAs Filename：="D：\folder\a.xls"

ActiveWorkbook.SaveAs Filename：="D：\folder\b.xls"

C,创建新文件夹folder1并把a.xls复制到新文件夹重新命名为c.xls

MkDir "D：\folder1"

FileCopy "D：\folder\a.xls", "D：\folder1\c.xls"

D,复制folder中所有文件到folder1

Set qqq = CreateObject("Scripting.FileSystemObject")

qqq.CopyFolder "D：\folder", "D：\folder1"

D,重命名a.xls为d.xls

name "d：\folder1\a.xls" as "d：\folder1\d.xls"

E,判断文件及文件夹是否存在

Set yyy = CreateObject("Scripting.FileSystemObject")

If yyy.FolderExists("D：\folder1) = True Then ...

If yyy.FileExists("D：\folder1\d.xls) = True Then ...

F,打开folder1中所有文件

Set rrr = CreateObject("Scripting.FileSystemObject")

Set r = rrr.GetFolder("d：\folder1")

For Each i In r.Files

Workbooks.Open Filename：=("d：\folder1\" + + "")

G,删除文件c.xls

kill "d：\folder1\c.xls"

H,删除文件夹folder

Set aaa = CreateObject("Scripting.FileSystemObject")

aaa.DeleteFolder "d：\folder"

2.excel vba一次性获取文件夹下的所有文件名的方法

小生今天上网下载了一个财务常用报表的文件包，里面有几百个excel工作表，要是手工一个一个的获得文件名的话，那我可是要忙十天半月哦。于是想到昨论坛就是vba论坛，昨不充分利用excel 自身的高级应用呀，呵呵，实现的代码如下，把工作量几天的任务可是一下子就完成了，这就是excel vba给你工作提高效率的结果！

excle vba自动获取同一文件夹下所有工作表的名称红色代码：

按Alt+F11，打开VBA编辑器，插入一个模块，把下面的代码贴进去，按F5执行 Sub t()

Dim s As FileSearch '定义一个文件搜索对象

Set s = Application.FileSearch

s.LookIn = "c：\" '注意路径，换成你实际的路径

s.Filename = "*.*" '搜索所有文件

s.Execute '执行搜索

Cells.Delete '表格清空

For i = 1 To s.FoundFiles.Count

Cells(i, 1) = s.FoundFiles(i) '每一行第一列填写一个文件名

End Sub

现在获得的可是带路径的工作表名，去掉前的路径可用以下方法；

=RIGHT(A1,LEN(A1)-FIND("#",SUBSTITUTE(A1,"\","#",LEN(A1)-LEN(SUBSTITUTE(A1,"\",)))))

最后用常规的方法往下拖，就完成了笔者所需的工作表名。

outlook下VBA编程：把公用文件夹里的邮件附件拷贝出来保存在硬盘上

2009-06-17 09：35

Sub SaveAttachments()

Dim oApp As Outlook.Application

Dim oNameSpace As NameSpace

Dim oFolder As MAPIFolder

Dim oMailItem As Object

Dim sMessage As String

BeforeDate = #10/1/2007# ' choose the end date of wanted

MyDir = "E：\liuxc-work\oil loss\backup from public folder\" ' choose the folder

location for save

Sender = "Hz121 Supervisor" ' caution, case sensitive

SendFile = "HZ121-1_Daily.xls"

MyY = 0

Set oApp = New Outlook.Application

Set oNameSpace = oApp.GetNamespace("MAPI")

Set oFolder = oNameSpace.PickFolder

For Each oMailItem In oFolder.Items

With oMailItem

MyT3 = Left(CStr(oMailItem.CreationTime), 10)

If CDate(oMailItem.CreationTime) >= BeforeDate Then

If oMailItem.SenderName = Sender Then

If oMailItem.Attachments.Count > 0 Then ' protect error

For i = 1 To oMailItem.Attachments.Count

If oMailItem.Attachments.Item(i).FileName = SendFile Then

MyT1 = InStr(1, oMailItem.Attachments.Item(i).FileName, ".", 1)

MyT2 = Left(oMailItem.Attachments.Item(i).FileName, 19) + "-" + MyT3 + ".xls"

oMailItem.Attachments.Item(i).SaveAsFile MyDir & MyT2

MsgBox oMailItem.Attachments.Item(i).DisplayName & " was saved as " & oMailItem.Attachments.Item(i).FileName

End If

Next i

End If

Else

MyY = MyY + 1

If MyY > 10 Then GoTo LoopEnd

End If

End With

Next oMailItem

LoopEnd：

' Set oMailItem = Nothing

' Set oFolder = Nothing

' Set oNameSpace = Nothing

' Set oApp = Nothing

3.Excel VBA把选定文件夹中的工作簿导入到新建ACCESS数据库中

2010-04-24 22：33

方法一

Sub Create_AccessProject()

Dim AccessData As Object

Set AccessData = CreateObject("Access.Application")

Dim Stpath As String

Stpath = ThisWorkbook.Path & "\DSEM-Stock-Allocation.mdb" '设定路径

If Dir(Stpath, vbDirectory) = "DSEM-Stock-Allocation.mdb" Then

Kill (Stpath)

End If

AccessData.NewCurrentDatabase Stpath

Set AccessData = Nothing '创建表格

Set cnnaccess = CreateObject("Adodb.Connection")

Set rstAnswers = CreateObject("Adodb.Recordset")

cnnaccess.Provider = "Microsoft.Jet.OLEDB.4.0"

Application.Wait Now() + TimeValue("00：00：02") '系统暂停2秒,以等待data.mdb建立成功

cnnaccess.Open "Data Source =" & Stpath & ";Jet OLEDB：Database Password=" & ""

'strSQL = "Create Table myData(last_date char(8))"

'rstAnswers.Open strSQL, cnnaccess

Set rstAnswers = Nothing

Set cnnaccess = Nothing

MyMainFile =

Dim CurFile As String

Application.DisplayAlerts = False

myFile = Application.GetOpenFilename("(*.xls),*.xls)", , "Please Select Files")

If myFile = False Then Exit Sub

VBA批量处理文件和文件夹的技巧

VBA（Visual Basic for Applications）是一种广泛应用于Microsoft Office套件中的编程语言，它可以帮助用户自动化和简化在Excel、Word、PowerPoint等应用中的重复操作。对于需要处理大量文件和文件夹的任务，使用VBA可以大大提高效率。本文将介绍一些VBA批量处理文件和文件夹的技巧，帮助用户在日常工作中更高效地完成相关任务。

1. 批量处理文件

在VBA中，可以使用File System Object（文件系统对象）来访问和处理文件。使用下面的代码可以批量处理指定文件夹中的所有文件：

```vba

Sub BatchProcessFiles()

Dim FileSystem As Object

Dim SourceFolder As Object

Dim FileItem As Object

' 设置源文件夹路径

Set FileSystem = CreateObject("Scripting.FileSystemObject") Set SourceFolder = FileSystem.GetFolder("C:\SourceFolder")

' 循环处理文件夹中的所有文件

For Each FileItem In SourceFolder.Files

' 在此处添加具体的文件处理逻辑

' 例如，可以使用获取文件名

' 若需要重新命名文件，可以使用 =

"NewFileName"

Next FileItem

' 清除对象

Set FileItem = Nothing

Set SourceFolder = Nothing

Set FileSystem = Nothing

VBA中的文件路径与文件夹操作

在进行VBA编程时，经常需要处理文件的操作，包括获取文件路径、创建文件夹、复制和移动文件等。本文将介绍VBA中的文件路径与文件夹操作的相关知识，并提供一些实用的代码示例。

1. 获取文件路径

要获取文件的路径，可以使用VBA提供的Dir和FileDialog函数。Dir函数可以用于检索指定路径下的文件名列表，而FileDialog函数则可以打开文件对话框，让用户选择文件并返回其路径。

以下是使用Dir函数获取文件路径的示例代码：

```

Sub GetFilePath_Dir()

Dim filePath As String

filePath = Dir("C:\Users\Username\Documents\example.txt")

If filePath <> "" Then

Debug.Print "文件路径：" & filePath

Else

Debug.Print "未找到文件" End If

End Sub

```

以下是使用FileDialog函数获取文件路径的示例代码：

```

Sub GetFilePath_FileDialog()

Dim filePath As String

Dim fileDialog As Object

Set fileDialog = Application.FileDialog(msoFileDialogFilePicker)

With fileDialog

.AllowMultiSelect = False

.Title = "选择文件"

If .Show = -1 Then

filePath = .SelectedItems(1)

Debug.Print "文件路径：" & filePath

Else

Debug.Print "未选择文件" End If