⑴ VBA提取當前工作簿所在文件夾的名稱
subt()
dimstr
str=ThisWorkbook.Path
MsgBoxRight(str,Len(str)-InStrRev(str,""))
endsub
用路徑整理下就是文件夾了啊~
⑵ Excel中VBA提取文件夾名稱的方法
文章介紹excel中使用vba提取文件名的操作步驟。根據需要自行修改vba提取文件名的路徑和存放單元格即可。
在excel中使用VBA編寫代碼,可以輕松的提取某個文件夾下面的所有文件名。
比如筆者在F盤下面建立了一個文件夾,文件夾的名稱是:office教程網,現在想將「office教程網」這個文件夾下面的所有文件名提取出來放在當前工作表的C列。
具體的vba提取文件名的操作如下:
1.按下ALT+F11,打開VBE編輯器。
2.執行「插入——模塊」,插入模塊1。
3.在右邊的代碼編輯窗口,復制下面的代碼,然後單擊「綠色箭頭」或者快捷鍵F5鍵,運行代碼。
Private Sub vba提取文件名()
Dim FileName As String
Dim i As Long
FileName = Dir("F:\office教程網\*.*")
i = 0
Range("C:C").ClearContents
Do While FileName > ""
i = i + 1
Cells(i, 3) = FileName
FileName = Dir
Loop
End Sub
4.關閉VBE窗口,回到工作表中,可以在C列看到F盤「office教程網」文件夾下面所有的文件名全部羅列在C列了。
關於上面的vba提取文件名的代碼,請在實際使用時,根據需要修改提取文件名的路徑(F:\office教程網\*.*),以及存放在C列的位置(Cells(i, 3))。
⑶ 如何用VBA建立查詢,打開指定文件夾內對應名稱的文件
Sub GetFolder()
Dim FolderName, FileName, MyFolder, MyFile As String
FolderName = "abc"
FileName = "abc.xls"
MyFolder = Dir("D:\" & FolderName, 16)
MyFile = Dir("D:\" & FolderName & "\" & FileName, 16)
If MyFolder <> "" Then
MsgBox "The folder is OK"
Else
MkDir "D:\" & FolderName
End If
If MyFile <> "" Then
MsgBox "The File is OK"
Else
Open "D:\" & FolderName & "\" & FileName For Output As #1
Close #1
End If
End Sub
⑷ 求編輯excel的 vba,sheet1列出文件夾內的全部excel的名稱 sheet2列出某sheet區域內容
附件中有樣本。
Sub獲取內容()
MsgBox"本代碼由巴蜀兄弟連xiaoxiao_蘿卜提供。liuchen8審核~"
DimfnAsString,strPahtAsString
DimwbAsWorkbook,shtAsWorksheet
Dimi,j,wbOpendInCodeAsBoolean
WithApplication.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect=False
.Show
If.SelectedItems.Count>0Then
strPath=.SelectedItems(1)
Else
strPath=ThisWorkbook.Path
EndIf
EndWith
fn=Dir(strPath&"*.xls*")
OnErrorResumeNext
Application.DisplayAlerts=False
Application.ScreenUpdating=False
Whilefn<>""
Err.Clear
wbOpendInCode=False
Iffn<>ThisWorkbook.NameThen
i=i+1
Sheet1.Cells(i,1)=fn
'以下代碼打開excel工作簿,並讀取應收情況表中的A4:C4的內容
Setwb=Workbooks(fn)'如果工作簿已經打開,則直接引用
IfErrThen
wbOpendInCode=True
Setwb=Workbooks.Open(Filename:=strPath&""&fn,ReadOnly:=True)
EndIf
ThisWorkbook.Activate
Err.Clear
IfNotwbIsNothingThen
Setsht=wb.Sheets("應收情況表")
IfErr=0Then'工作簿中應收情況表
j=j+1
sht.Range("A4:C4").CopySheet2.Cells(j,1)
EndIf
EndIf
IfwbOpendInCodeThenwb.Closesavechanges:=False'關閉在代碼中打開的工作簿,
EndIf
Application.DisplayAlerts=True
Application.ScreenUpdating=True
fn=Dir
Wend
EndSub
⑸ 用VBA代碼如何獲得指定文件夾內的所有子文件夾名稱
Set fso=CreateObject("Scripting.FileSystemObject")
Set folder=fso.GetFolder("D:")
dim a() as string
dim b
b=1
for each thing in folder.subfolders
addfolder fso,thing,a,b
next
msgbox b
function addfolder(byref fso,byref dir,byref a,byref b)
set folder=fso.getfolder(dir)
a(b)=dir
b=b+1
For Each thing in folder.SubFolders
set folder=fso.getfolder(thing)
a(b)=thing
b=b+1
addfolder fso,thing,a,b
Next
end function
⑹ 用EXCEL VBA獲取指定目錄下的文件名(包括文件夾名)
1、首先利用快捷鍵「Windows鍵+R」打開「運行」窗口
⑺ EXCEL怎樣用VBA自動提取文件夾內的文件名
qgrmdtj的代碼生成的是"文件名",這和樓主的要求一樣,而"喜歡自作多情 "生成的結果是代路徑的,好像和提問有點偏差.
⑻ Excel VBA列出某文件夾下子文件夾及文件名
遍歷文件夾 並列出文件 & 文件夾 名 代碼如下:
在文件夾內 新建 個 Excel文件
Excel文件內 按 Alt+F11 視圖--代碼窗口, 把如下代碼復制進去, F5運行
Sub遍歷文件夾()
'OnErrorResumeNext
Dimfn(1To10000)AsString
Dimf,i,k,f2,f3,x
Dimarr1(1To100000,1To1)AsString,qAsInteger
Dimt
t=Timer
fn(1)=ThisWorkbook.path&""
i=1:k=1
DoWhilei<UBound(fn)
Iffn(i)=""ThenExitDo
f=Dir(fn(i),vbDirectory)
Do
IfInStr(f,".")=0Andf<>""Then
k=k+1
fn(k)=fn(i)&f&""
EndIf
f=Dir
LoopUntilf=""
i=i+1
Loop
'*******下面是提取各個文件夾的文件***
Forx=1ToUBound(fn)
Iffn(x)=""ThenExitFor
f3=Dir(fn(x)&"*.*")
DoWhilef3<>""
q=q+1
arr1(q,1)=fn(x)&f3
f3=Dir
Loop
Nextx
ActiveSheet.UsedRange=""
Range("a1").Resize(q)=arr1
MsgBoxFormat(Timer-t,"0.00000")
EndSub
效果如圖:
⑼ 如何利用excel vba自動列出指定文件夾目錄下的所有文件
下面的例子代碼顯示C:所有文件,供你參考:
OptionExplicit
Subygb()
Dimf,i
i=1
f=Dir("c:")
Whilef<>""
Cells(i,"A")=f
i=i+1
f=Dir
Wend
EndSub
⑽ vba 遍歷指定文件夾(含子目錄)獲取文件名,哪種方法速度最快
Sub LoopAllExcelFilesInFolder()
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
'這里很關鍵,決定宏執行快慢的關鍵
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'打開目錄選擇框
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "請選擇目錄"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
'取消選擇
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
'指定過濾的文件後綴
myExtension = "*.xls*"
'遍歷全路徑
myFile = Dir(myPath & myExtension)
'循環處理每一個文件
Do While myFile <> ""
'打開
Set wb = Workbooks.Open(Filename:=myPath & myFile)
'確保工作簿被打開,在處理下一個文件時
DoEvents
'設置背景色
wb.Worksheets(1).Range("A1:Z1").Interior.Color = RGB(51, 98, 174)
'保存工作簿
wb.Close SaveChanges:=True
'確保工作簿被關閉,在處理下一個文件時
DoEvents
'接著處理下一個
myFile = Dir
Loop
'提示處理完成
MsgBox "處理完成!"
ResetSettings:
'恢復設置
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub