vba 文件操作服务器,VBA文件及文件夹操作
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\" + i.Name +"")
Next
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) '每一行第一列填写一个文件名
Next
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 frompublic folder\"' choose thefolder 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).SaveAsFileMyDir & MyT2
MsgBoxoMailItem.Attachments.Item(i).DisplayName & " was saved as "& oMailItem.Attachments.Item(i).FileName
End If
Next i
End If
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 TablemyData(last_date char(8))"
'rstAnswers.Open strSQL, cnnaccess
Set rstAnswers = Nothing
Set cnnaccess = Nothing
MyMainFile = ThisWorkbook.Name
Dim CurFile As String
Application.DisplayAlerts = False
myFile =Application.GetOpenFilename("(*.xls),*.xls)", , "Please SelectFiles")
If myFile = False Then Exit Sub
DirLoc = CurDir(myFile) & "\"
CurFile = Dir(DirLoc &"*.xls")
Do While CurFile <> vbNullString
Set objAccess = CreateObject("Access.Application")
LinkFile = DirLoc & CurFile
TableName = Left(CurFile, Len(CurFile) - 4)
If CurFile ="HONHAI-VMIData1.xls" Then
With objAccess
.OpenCurrentDatabase (ThisWorkbook.Path& "\DSEM-Stock-Allocation.mdb")
.DoCmd.TransferSpreadsheet acLink, 8, TableName,LinkFile, True, "Aging Report$"
End With
objAccess.CloseCurrentDatabase
Set objAccess = Nothing
CurFile = Dir
Else
With objAccess
.OpenCurrentDatabase (ThisWorkbook.Path& "\DSEM-Stock-Allocation.mdb")
.DoCmd.TransferSpreadsheet acImport, 8,TableName, LinkFile, True, ""
End With
objAccess.CloseCurrentDatabase
Set objAccess = Nothing
CurFile = Dir
End If
Loop
End Sub
方法二
Sub Folder2Access()
Dim db As DAO.Database
Dim ws As DAO.Workspace
Set ws = DBEngine.Workspaces(0)
Set db = ws.OpenDatabase("C:\CustomersDataBase\DSEM-PO-Stock-Status.mdb",False, False, "")
db.Execute ("delete * from[DSEM-MovingPlan]")
db.Close
Set db = Nothing
Dim myFile As String
Dim s As FileSearch '定义一个文件搜索对象
Set s = Application.FileSearch
s.LookIn = "C:\CustomersDataBase\Test\" '注意路径,换成你实际的路径
s.Filename = "*.*" '搜索所有文件
s.Execute '执行搜索
For i = 1 To s.FoundFiles.Count
FullName1 = Right(s.FoundFiles(i),Len(s.FoundFiles(i)) - Len("C:\CustomersDataBase\Test\"))
Filename = Left(FullName1, Len(FullName1) -4)
Set objAccess =CreateObject("Access.Application")
myFile = "C:\CustomersDataBase\Test\"& Filename & ".xls"
With objAccess
.OpenCurrentDatabase ("C:\CustomersDataBase\DSEM-PO-Stock-Status.mdb")
.DoCmd.TransferSpreadsheet acImport, 8,"DSEM-MovingPlan", myFile, True, ""
End With
objAccess.CloseCurrentDatabase
Set objAccess = Nothing
Next
End Sub
4.vba操作文件及文件夹示例
2009-08-20 00:07
vba操作文件及文件夹示例
利用excel中的vba可以对电脑中的文件及文件夹做一些常用的操作。
包括复制、重命名、删除等,其中一些简单的示例总结如下。
希望对一些经常需要批量处理文件的朋友有所帮助,也希望感兴趣的朋友多多指教!以下代码建议在on error resume next下测试
1,在D:\下新建文件夹,命名为folder
方法1:MkDir "D:\folder"
方法2:Set abc =CreateObject("Scripting.FileSystemObject")
abc.CreateFolder ("D:\folder")
2,新建2个文件命名为a.xls和b.xls
Workbooks.Add
ActiveWorkbook.SaveAs Filename:="D:\folder\a.xls"
ActiveWorkbook.SaveAs Filename:="D:\folder\b.xls"
3,创建新文件夹folder1并把a.xls复制到新文件夹重新命名为c.xls
MkDir "D:\folder1"
FileCopy "D:\folder\a.xls", "D:\folder1\c.xls"
4,复制folder中所有文件到folder1
Set qqq =CreateObject("Scripting.FileSystemObject")
qqq.CopyFolder "D:\folder", "D:\folder1"
5,重命名a.xls为d.xls
name "d:\folder1\a.xls" as "d:\folder1\d.xls"
6,判断文件及文件夹是否存在
Set yyy =CreateObject("Scripting.FileSystemObject")
If yyy.FolderExists("D:\folder1) = True Then ...
If yyy.FileExists("D:\folder1\d.xls) = True Then ...
7,打开folder1中所有文件
Set rrr =CreateObject("Scripting.FileSystemObject")
Set r = rrr.GetFolder("d:\folder1")
For Each i In r.Files
Workbooks.Open Filename:=("d:\folder1\" + i.Name +"")
Next 8,删除文件c.xls
kill "d:\folder1\c.xls" 9,删除文件夹folder
Set aaa =CreateObject("Scripting.FileSystemObject")
aaa.DeleteFolder "d:\folder"
VBA Dir函数遍历文件夹下的所有文件
2010-05-26 17:30
5.VBA Dir函数
第1.12例Dir函数
一、题目:
要求编写一段代码,运用Dir函数返回一个文件夹的文件列表。
二、代码:
Sub示例_1_12()
Dim wjm
wjm = Dir("C:\WINDOWS\WIN.ini")
MsgBox wjm
wjm = Dir("C:\WINDOWS\*.ini")
wjm = Dir
End Sub
三、代码详解
1、Sub示例_1_12():宏程序的开始语句。宏名为示例_1_12。
2、Dim wjm:变量wjm声明为可变型数据类型。
3、wjm = Dir("C:\WINDOWS\WIN.ini"):
如果该文件存在则返回“WIN.INI”(在C:\Windows文件夹中),把返回的文件名赋给变量wjm。如果该文件不存在则wjm=””。
4、wjm = Dir("C:\WINDOWS\*.ini"):
返回带指定扩展名的文件名。如果超过一个*.ini文件存在,函数将返回按条件第一个找到的文件名。
5、wjm = Dir:
若第二次调用Dir函数,但不带任何参数,则函数将返回同一目录下的下一个*.ini文件。
Dir函数
返回一个字符串String,用以表示一个文件名、目录名或文件夹名称,它必须与指定的模式或文件属性、或磁盘卷标相匹配。
Dir[(pathname[, attributes])]
Dir函数的语法具有以下几个部分:
pathname可选参数。用来指定文件名的字符串表达式,可能包含目录或文件夹、以及驱动器。如果没有找到pathname,则会返回零长度字符串("")。
attributes可选参数。常数或数值表达式,其总和用来指定文件属性。如果省略,则会返回匹配pathname但不包含属性的文件。
EXCEL的VBA用于同时显示目录文件夹和文件列表
2010-05-22 18:41
”VBA工具中要引用microsoft scipting runtime
Dim pt As Range
Sub查找文件夹下子文件夹及其大小()
Dim theDir As String
Set pt = ActiveSheet.Range("a1")
pt.Worksheet.Columns(1).ClearContents'清除第一列
theDir = Application.InputBox("输入指定文件夹的路径:", "查看子文件夹及其大小")
pt = theDir‘列出选取的目录名
listPath theDir’用于列出子目录和文件
pt.Worksheet.Columns("a:b").AutoFit
End Sub
Sub listPath(strDir As String)
Dim thePath As String
Dim strSdir As String
Dim theDirs As Scripting.Folders
Dim theDir As Scripting.Folder
Dim row As Integer
Dim s As String
Dim myFso As Scripting.FileSystemObject
Set myFso = New Scripting.FileSystemObject
If Right(strDir, 1) <> "\"Then strDir = strDir & "\"
thePath = thePath & strDir
row = pt.row'此段为获取此目录下的文件名
s = Dir(thePath, 7)'获取第一个文件
Do While s <> ""
row = row + 1
Cells(row, 1) = s'文件的名称
Cells(row, 1).Font.Color = RGB(256, 12,213)
Cells(row, 1).Font.Bold = Ture
s = Dir‘下一个文件
Loop
Set pt = Cells(row, 1)
Set pt = pt.Offset(1, 0)
Set theDirs = myFso.getfolder(strDir).subfolders
For Each theDir In theDirs
pt = theDir.Path
pt.Next = theDir.Size
listPath theDir.Path
Next
Set myFso = Nothing
End Sub
Private Sub CommandButton1_Click()
查找文件夹下子文件夹及其大小
End Sub
6.用VBA获取文件夹中的文件列表
如果我们要在Excel中获取某个文件夹中所有的文件列表,可以通过下面的VBA代码来进行。代码运行后,首先弹出一个浏览文件夹对话框,然后新建一个工作簿,并在工作表的A至F列分别列出选定文件夹中的所有文件的文件名、文件大小、创建时间、修改时间、访问时间及完整路径。方法如下:
1.按Alt+F11,打开VBA编辑器,单击菜单“插入→模块”,将下面的代码粘贴到右侧的代码窗口中:
Option Explicit
Sub GetFileList()
Dim strFolder As String
Dim varFileList As Variant
Dim FSO As Object, myFile As Object
Dim myResults As Variant
Dim l As Long
'显示打开文件夹对话框
WithApplication.FileDialog(msoFileDialogFolderPicker)
.Show
If .SelectedItems.Count = 0 Then Exit Sub '未选择文件夹
strFolder = .SelectedItems(1)
End With
'获取文件夹中的所有文件列表
varFileList = fcnGetFileList(strFolder)
If Not IsArray(varFileList) Then
MsgBox "未找到文件", vbInformation
Exit Sub
End If
'获取文件的详细信息,并放到数组中
ReDim myResults(0 To UBound(varFileList) +1, 0 To 5)
myResults(0, 0) = "文件名"
myResults(0, 1) = "大小(字节)"
myResults(0, 2) = "创建时间"
myResults(0, 3) = "修改时间"
myResults(0, 4) = "访问时间"
myResults(0, 5) = "完整路径"
Set FSO =CreateObject("Scripting.FileSystemObject")
For l = 0 To UBound(varFileList)
Set myFile =FSO.GetFile(CStr(varFileList(l)))
myResults(l + 1, 0) = CStr(varFileList(l))
myResults(l + 1, 1) = myFile.Size
myResults(l + 1, 2) = myFile.DateCreated
myResults(l + 1, 3) =myFile.DateLastModified
myResults(l + 1, 4) =myFile.DateLastAccessed
myResults(l + 1, 5) = myFile.Path
Next l
fcnDumpToWorksheet myResults
Set myFile = Nothing
Set FSO = Nothing
End Sub
Private Function fcnGetFileList(ByValstrPath As String, Optional strFilter As String) As Variant
'如果文件夹中包含文件返回一个二维数组,否则返回False
Dim f As String
Dim i As Integer
Dim FileList() As String
If strFilter = "" Then strFilter= "*.*"
Select Case Right$(strPath, 1)
Case "\", "/"
strPath = Left$(strPath, Len(strPath) - 1)
End Select
ReDim Preserve FileList(0)
f = Dir$(strPath & "\" &strFilter)
Do While Len(f) > 0
ReDim Preserve FileList(i) As String
FileList(i) = f
i = i + 1
f = Dir$()
Loop
If FileList(0) <> Empty Then
fcnGetFileList = FileList
Else
fcnGetFileList = False
End If
End Function
Private Sub fcnDumpToWorksheet(varData AsVariant, Optional mySh As Worksheet)
Dim iSheetsInNew As Integer
Dim sh As Worksheet, wb As Workbook
Dim myColumnHeaders() As String
Dim l As Long, NoOfRows As Long
If mySh Is Nothing Then
'新建一个工作簿
iSheetsInNew =Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Set wb = Application.Workbooks.Add
Application.SheetsInNewWorkbook =iSheetsInNew
Set sh = wb.Sheets(1)
Else
Set mySh = sh
End If
With sh
Range(.Cells(1, 1), .Cells(UBound(varData,1) + 1, UBound(varData, 2) + 1)) = varData
.UsedRange.Columns.AutoFit
End With
Set sh = Nothing
Set wb = Nothing
End Sub
2.关闭VBA编辑器,回到Excel工作表中,按Alt+F8,打开“宏”对话框,选择“GetFileList”,单击“运行”按钮。
7.VBA中如何取文件的最后修改时间?
已经解决了,新的代码
---------------------------------------------
Sub searchfiles()
With Application.FileSearch
.NewSearch
.LookIn = "D:\ttt"
.Filename = "*.xls"
.SearchSubFolders = True
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Worksheets("sheet3").Cells(i,2).Value = .FoundFiles(i)
Dim fs, f, s
Set fs =CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFile(.FoundFiles(i))
s = "Created:" & f.DateCreated
Worksheets("sheet3").Cells(i,3).Value = s
Set f = Nothing
Set fs = Nothing
Next i
Else
MsgBox "no file found."
End If
End With
End Sub
8.VBA代码调用浏览文件夹对话框的几种方法
2009-05-25 15:24
1、使用API方法
'【类型声明】
Private Type BROWSEINFO
hWndOwnerAs Long
pIDLRootAs Long
pszDisplayName As Long
lpszTitleAs Long
ulFlagsAs Long
lpfnCallbackAs Long
lParamAs Long
iImageAs Long
End Type
'【API声明】
Private Declare FunctionSHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA"(ByVal pidl As Long, _
ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolderLib "shell32.dll" _
Alias "SHBrowseForFolderA"(lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function lstrcat Lib"kernel32" _
Alias "lstrcatA" (ByVal lpString1As String, _
ByVal lpString2 As String) As Long
Private Declare Function OleInitialize Lib"ole32.dll" _
(lp As Any) As Long
Private Declare Sub OleUninitialize Lib"ole32" ()
Private Const BIF_USENEWUI = &H40
Private Const MAX_PATH = 260
'【自定义函数】
Public Function GetFolder_API(sTitle AsString, Optional vFlags As Variant) As String
Dim lpIDList As Long
Dim sBuffer As String
Dim BInfo As BROWSEINFO
If IsMissing(vFlags) Then vFlags =BIF_USENEWUI
Call OleInitialize(ByVal 0&)
With BInfo
.lpszTitle = lstrcat(sTitle, "")
.ulFlags = vFlags
End With
lpIDList = SHBrowseForFolder(BInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer,vbNullChar) - 1)
If sBuffer <> "" ThenGetFolder_API = sBuffer
End If
Call OleUninitialize
End Function
'【使用方法】
Sub Test()
MsgBox GetFolder_API("选择文件夹")
End Sub
2、使用Shell.Application方法
Sub GetFloder_Shell()
Set objShell =CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0,"选择文件夹",0, 0)
If Not objFolder Is Nothing Then
MsgBox objFolder.self.path
End If
Set objFolder = Nothing
Set objShell = Nothing
End Sub
3、使用FileDialog方法
Sub GetFloder_FileDialog()
Dim fd As FileDialog
Set fd =Application.FileDialog(msoFileDialogFolderPicker)
If fd.Show = -1 Then MsgBoxfd.SelectedItems(1)
Set fd = Nothing
End Sub
以上方法在WINXP+OFFICE2003中测试通过
Excel VBA选择目标文件夹方法
2009-04-13 08:49
9.用VBA选择目标文件夹
几种实现代码:
1.FileDialog属性
Sub Sample1()
WithApplication.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
MsgBox .SelectedItems(1)
'txtFolder.Text = .SelectedItems(1)
End If
End With
End Sub
2.shell方法
Sub Sample2()
Dim Shell, myPath
Set Shell =CreateObject("Shell.Application")
Set myPath = Shell.BrowseForFolder(&O0,"请选择文件夹",&H1 + &H10, "G:\")
If Not myPath Is Nothing Then MsgBoxmyPath.Items.Item.Path
Set Shell = Nothing
Set myPath = Nothing
End Sub
3.API方法
Declare Function SHGetPathFromIDList Lib"shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, ByVal pszPath AsString) As Long
Declare Function SHBrowseForFolder Lib"shell32.dll" Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As Long
Declare Function GetDesktopWindow Lib"user32" () As Long
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Sub Sample3()
Dim buf As String
buf = GetFolder("请选择文件夹")
If buf = "" Then Exit Sub
MsgBox buf
End Sub
Function GetFolder(Optional Msg) As String
Dim bInfo As BROWSEINFO, pPath As String
Dim R As Long, X As Long, pos As Integer
bInfo.pidlRoot = 0&
bInfo.lpszTitle = Msg
bInfo.ulFlags = &H1
X = SHBrowseForFolder(bInfo)
pPath = Space$(512)
R = SHGetPathFromIDList(ByVal X, ByValpPath)
If R Then
pos = InStr(pPath, Chr$(0))
GetFolder = Left(pPath, pos - 1)
Else
GetFolder = ""
End If
End Function
10.VBA代码调用浏览文件夹对话框的几种方法
1、使用API方法
'【类型声明】
Private Type BROWSEINFO
hWndOwnerAs Long
pIDLRootAs Long
pszDisplayName As Long
lpszTitleAs Long
ulFlagsAs Long
lpfnCallbackAs Long
lParamAs Long
iImageAs Long
End Type
'【API声明】
Private Declare FunctionSHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA"(ByVal pidl As Long, _
ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolderLib "shell32.dll" _
Alias "SHBrowseForFolderA"(lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function lstrcat Lib"kernel32" _
Alias "lstrcatA" (ByVal lpString1As String, _
ByVal lpString2 As String) As Long
Private Declare Function OleInitialize Lib"ole32.dll" _
(lp As Any) As Long
Private Declare Sub OleUninitialize Lib"ole32" ()
Private Const BIF_USENEWUI = &H40
Private Const MAX_PATH = 260
'【自定义函数】
Public Function GetFolder_API(sTitle AsString, Optional vFlags As Variant) As String
Dim lpIDList As Long
Dim sBuffer As String
Dim BInfo As BROWSEINFO
If IsMissing(vFlags) Then vFlags =BIF_USENEWUI
Call OleInitialize(ByVal 0&)
With BInfo
.lpszTitle = lstrcat(sTitle, "")
.ulFlags = vFlags
End With
lpIDList = SHBrowseForFolder(BInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer,vbNullChar) - 1)
If sBuffer <> "" ThenGetFolder_API = sBuffer
End If
Call OleUninitialize
End Function
'【使用方法】
Sub Test()
MsgBox GetFolder_API("选择文件夹")
End Sub
2、使用Shell.Application方法
Sub GetFloder_Shell()
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0,"选择文件夹",0, 0)
If Not objFolder Is Nothing Then
MsgBox objFolder.self.path
End If
Set objFolder = Nothing
Set objShell = Nothing
End Sub
3、使用FileDialog方法
Sub GetFloder_FileDialog()
Dim fd As FileDialog
Set fd =Application.FileDialog(msoFileDialogFolderPicker)
If fd.Show = -1 Then MsgBoxfd.SelectedItems(1)
Set fd = Nothing
End Sub
以上方法在WINXP+OFFICE2003中测试通过
11.VBA操作,删除,新建文件夹
Sub qd_name_del()'删除启动查找目录及文件
'On Error Resume Next'忽略错误,如果有错误发生就执行下一语句
Set fs =CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder("C:\Documents andSettings\winxp")
f.Delete
End Sub
简单就是
CreateObject("scripting.filesystemobject").getfolder(strpathname).Delete
利用excel中的vba可以对电脑中的文件及文件夹做一些常用的操作。包括复制、重命名、删除等,其中一些简单的示例总结如下。 希望对一些经常需要批量处理文件的朋友有所帮助,也希望感兴趣的朋友多多指教!
以下代码建议在onerror resume next下测试1,在D:\下新建文件夹,命名为folder方法1:MkDir "D:\folder"方法2:Set abc = CreateObject("Scripting.FileSystemObject")abc.CreateFolder ("D:\folder")
2,新建2个文件命名为a.xls和b.xls Workbooks.AddActiveWorkbook.SaveAs Filename:="D:\folder\a.xls" ActiveWorkbook.SaveAs Filename:="D:\folder\b.xls"
3,创建新文件夹folder1并把a.xls复制到新文件夹重新命名为c.xlsMkDir "D:\folder1"FileCopy "D:\folder\a.xls","D:\folder1\c.xls"
4,复制folder中所有文件到folder1Set qqq = CreateObject("Scripting.FileSystemObject") qqq.CopyFolder"D:\folder","D:\folder1"
5,重命名a.xls为d.xls name"d:\folder1\a.xls"as "d:\folder1\d.xls"
6,判断文件及文件夹是否存在
Set yyy =CreateObject("Scripting.FileSystemObject")
If yyy.FolderExists("D:\folder1) = True
Then ... If yyy.FileExists("D:\folder1\d.xls) = True
Then ...
7,打开folder1中所有文件Set rrr = CreateObject("Scripting.FileSystemObject") Setr = rrr.GetFolder("d:\folder1") For Each i In r.Files Workbooks.Open Filename:=("d:\folder1\" + i.Name +"") Next
8,删除文件c.xls kill "d:\folder1\c.xls"
9,删除文件夹folder Set aaa =CreateObject("Scripting.FileSystemObject") aaa.DeleteFolder "d:\folder"
12.可以通过控件或者代码新建一个文件夹吗?
Dimfso'AsObject
Setfso=CreatObject(“Scripting.FileSystemObject”)
fso.CreateFolder(foldername)
不过运行不了......
Setfso=CreatObject(“Scripting.FileSystemObject”)
提示这一句有错......
但是如果文件夹已经存在了会出错
那怎么判断一个文件夹存不存在?
DimfsoAsNewFileSystemObject
iffso.FolderExistsfolderNamethen
msgbox"文件夹已存在!"
else
fso.CreateFolder(foldername)
endif
FileSystemObject不能用的话,在工程里添加一下引用"microsoftScriptingruntime "
13.怎么判断一个文件夹存不存在?
DimfsoAsNewFileSystemObject
iffso.FolderExistsfolderNamethen
msgbox"文件夹已存在!"
else
fso.CreateFolder(foldername)
endif
FileSystemObject不能用的话,在工程里添加一下引用"microsoftScriptingruntime "
14.FolderExists方法
如果指定的文件夹存在,则返回True;否则返回False。
object.FolderExists(folderspec)
参数
object
必选项。应为FileSystemObject的名称。
folderspec
必选项。文件夹名称,表示要确定是否存在的文件夹。如果该文件夹不在当前文件夹中,则必须提供完整路径名(绝对路径或相对路径)。
说明
下面例子举例说明如何使用FolderExists方法:
Function ReportFolderStatus(fldr)
Dim fso, msg
Set fso =CreateObject("Scripting.FileSystemObject")
If (fso.FolderExists(fldr)) Then
msg = fldr & "存在。"
Else
msg = fldr & "不存在。"
End If
ReportFolderStatus = msg
End Function
15.vba操作文件及文件夹示例
利用excel中的vba可以对电脑中的文件及文件夹做一些常用的操作。包括复制、重命名、删除等,其中一些简单的示例总结如下。希望对一些经常需要批量处理文件的朋友有所帮助,也希望感兴趣的朋友多多指教!
以下代码建议在onerror resume next下测试
1,在D:\下新建文件夹,命名为folder
方法1:
MkDir "D:\folder"
方法2:
Set abc =CreateObject("Scripting.FileSystemObject") abc.CreateFolder ("D:\folder")
2,新建2个文件命名为a.xls和b.xls
Workbooks.Add ActiveWorkbook.SaveAsFilename:="D:\folder\a.xls"ActiveWorkbook.SaveAs Filename:="D:\folder\b.xls"
3,创建新文件夹folder1并把a.xls复制到新文件夹重新命名为c.xlsMkDir "D:\folder1"FileCopy "D:\folder\a.xls","D:\folder1\c.xls"
4,复制folder中所有文件到folder1Set qqq = CreateObject("Scripting.FileSystemObject") qqq.CopyFolder"D:\folder","D:\folder1"
5,重命名a.xls为d.xls name"d:\folder1\a.xls"as "d:\folder1\d.xls"
6,判断文件及文件夹是否存在
Set yyy =CreateObject("Scripting.FileSystemObject")
If yyy.FolderExists("D:\folder1) = True
Then ... If yyy.FileExists("D:\folder1\d.xls) = True
Then ...
7,打开folder1中所有文件Set rrr = CreateObject("Scripting.FileSystemObject") Setr = rrr.GetFolder("d:\folder1") For Each i In r.Files Workbooks.Open Filename:=("d:\folder1\" + i.Name +"") Next
8,删除文件c.xls kill "d:\folder1\c.xls"
9,删除文件夹folder Set aaa =CreateObject("Scripting.FileSystemObject") aaa.DeleteFolder "d:\folder"
16.用VBA新建文件夹
MkDir语句示例
本示例使用MkDir语句来创建目录或文件夹。如果没有指定驱动器,新目录或文件夹将会建在当前驱动器中。
MkDir "MYDIR"'建立新的目录或文件夹。
MkDir "C:\Temp"''在C盘根目录下新一个名为Temp的文件夹.
MkDir必须逐级建立文件夹,或者说它的上一级目录必须存在后才能建议,不能跨级建立,如
MkDir "C:\Temp\Test",如果C盘Temp目录不存在时,将出现错误.
vba 文件操作服务器,VBA文件及文件夹操作相关推荐
- 怎么传文件到服务器上,怎样传文件到服务器上
怎样传文件到服务器上 内容精选 换一换 华为云帮助中心,为用户提供产品简介.价格说明.购买指南.用户指南.API参考.最佳实践.常见问题.视频帮助等技术文档,帮助您快速上手使用华为云服务. 安装传输工 ...
- 云服务器centos登录日志文件,云服务器centos登录日志文件
云服务器centos登录日志文件 内容精选 换一换 提供多个业务节点提供共享的日志输出目录,方便分布式应用的日志收集和管理.业务特点:多个业务主机挂载同一个共享文件系统,并发打印日志.大文件小I/O: ...
- 华为云服务器 大文件,云服务器上传大文件
云服务器上传大文件 内容精选 换一换 本节操作介绍本地MacOS系统主机通过安装"Microsoft Remote Desktop for Mac"工具向Windows云服务器传输 ...
- 服务器文件描述,服务器编程中的文件描述符
Linux系统下一切皆文件,通过虚拟文件系统(VFS)的机制将所有底层屏蔽掉,用户可以通过统一的接口来实现对不同驱动的操作,对于每一个文件需要一个引用来指示,此时文件描述符应用而生,文件描述符类似于W ...
- 如何将文件拷贝服务器上,如何将文件复制到云服务器上
如何将文件复制到云服务器上 内容精选 换一换 将文件上传至Windows云服务器一般会采用MSTSC远程桌面连接的方式.本节为您介绍本地Windows计算机通过远程桌面连接,上传文件至Windows云 ...
- 服务器本地打开asp文件路径,服务器本地打开asp文件
服务器本地打开asp文件 内容精选 换一换 本节操作指导您完成Windows操作系统云服务器磁盘空间清理.弹性云服务器匀出一部分磁盘空间来充当内存使用,当内存耗尽时,云服务器可以使用虚拟内存来缓解内存 ...
- mt4的服务器在哪个文件,MT4服务器地址在哪个文件
MT4服务器地址在哪个文件 内容精选 换一换 本节操作介绍本地MacOS系统主机通过安装"Microsoft Remote Desktop for Mac"工具向Windows云服 ...
- Git上传本地文件到服务器,git上传文件到远程服务器
git上传文件到远程服务器 内容精选 换一换 将文件上传至Windows云服务器一般会采用MSTSC远程桌面连接的方式.本节为您介绍本地Windows计算机通过远程桌面连接,上传文件至Windows云 ...
- 上传文件到服务器指令,上传文件到远程服务器的命令
上传文件到远程服务器的命令 内容精选 换一换 将文件上传至Windows云服务器一般会采用MSTSC远程桌面连接的方式.本节为您介绍本地Windows计算机通过远程桌面连接,上传文件至Windows云 ...
最新文章
- PHP中$_SERVER[QUERY_STRING]函数
- 使用jstack 发现死锁
- 【跃迁之路】【706天】程序员高效学习方法论探索系列(实验阶段463-2019.1.26-27)...
- 一段JS代码实现光标定位输入框文字最后
- 打开FTP server或者wftpd32提示 unknow error 10013
- HTML中的三目表达式可以有多长
- 「 数学模型 」“三角函数化简公式”小结
- 任务管理器已被管理员停用 解决方法
- 各位想不想知道,360的保镖,在保护什么?
- 逆透视变换(IPM)多种方式及代码总结
- 2022-03-清华管理学-清华大学-宁向东
- css3中的属性选择器以及新增伪类
- 手游族迎来360手机卫士神助攻 玩家免打扰尽情发育
- 【Matlab】希腊字母
- fedora下载工具
- win10计算机ip如何更改,Win10本地连接ip怎么更改_Win10怎么更改ip地址?-192路由网...
- 关于电子产品克隆,PCB抄板与芯片解密缺一不可!
- Facebook投手的多账号管理软件-VMLogin中文版防关联浏览器-安全高效管理每个Facebook帐号
- form表单中的 action=./? 是什么意思
- java求互质数_判断互质数的五种方法