excelvba獲取文件名並修改

Ⅰ 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)）。

Ⅱ Excel 請問怎樣用VBA重命名文件

1、首先我們打開一個工作樣表作為例子。

Ⅲ 如何利用vba代碼批量提取文件名及修改日期到Excel表

程序代抄碼：

OptionExplicit

SubYgB()
Dimp,i,fn
i=1
p="d:doc"
fn=Dir(p&"*.*")
Whilefn<>""
Cells(i,1)=fn
Cells(i,2)=FileDateTime(p&fn)
i=i+1
fn=Dir
Wend
EndSub

運行示例：

Ⅳ VBA 如何取C盤下和C盤文件夾下所有Excel文件名稱，並將這些文件名放到Excel文件上。

VBA遍歷文件夾常用有三種方法，這三種方法中,filesearch不適合2007和2010版本，而且速度比較慢，遞歸法速度也慢。只有用DIR加循環的方法，速度飛快。下面是三種方法的代碼：
1、filesearch法
Sub test3()
Dim wb As Workbook
Dim i As Long
Dim t
t = Timer
With Application.FileSearch '調用fileserch對象
.NewSearch '開始新的搜索
.LookIn = ThisWorkbook.path '設置搜索的路徑
.SearchSubFolders = True '搜索范圍包括 LookIn 屬性指定的文件夾中的所有子文件夾
.Filename = "*.xls" '設置搜索的文件類型
' .FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then '如果找到文件
For i = 1 To .FoundFiles.Count
'On Error Resume Next
Cells(i, 1) = .FoundFiles(i) '把找到的文件放在單元格里
Next i
Else
MsgBox "沒找到文件"
End If
End With
MsgBox Timer - t
End Sub
2、遞歸法
Sub Test()
Dim iPath As String, i As Long
Dim t
t = Timer
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "請選擇要查找的文件夾"
If .Show Then
iPath = .SelectedItems(1)
End If
End With

If iPath = "False" Or Len(iPath) = 0 Then Exit Sub

i = 1
Call GetFolderFile(iPath, i)
MsgBox Timer - t
MsgBox "文件名鏈接獲取完畢。", vbOKOnly, "提示"

End Sub
Private Sub GetFolderFile(ByVal nPath As String, ByRef iCount As Long)
Dim iFileSys
'Dim iFile As Files, gFile As File
'Dim iFolder As Folder, sFolder As Folders, nFolder As Folder
Set iFileSys = CreateObject("Scripting.FileSystemObject")
Set iFolder = iFileSys.GetFolder(nPath)
Set sFolder = iFolder.SubFolders
Set iFile = iFolder.Files
With ActiveSheet
For Each gFile In iFile
' .Hyperlinks.Add anchor:=.Cells(iCount, 1), Address:=gFile.path, TextToDisplay:=gFile.Name
iCount = iCount + 1
Next
End With

'遞歸遍歷所有子文件夾
For Each nFolder In sFolder
Call GetFolderFile(nFolder.path, iCount)
Next
End Sub
3、dir循環法
Sub Test() '使用雙字典，旨在提高速度
Dim MyName, Dic, Did, i, t, F, TT, MyFileName
'On Error Resume Next
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "選擇文件夾", 0, 0)
If Not objFolder Is Nothing Then lj = objFolder.self.path & "\"
Set objFolder = Nothing
Set objShell = Nothing
t = Time
Set Dic = CreateObject("Scripting.Dictionary") '創建一個字典對象
Set Did = CreateObject("Scripting.Dictionary")
Dic.Add (lj), ""
i = 0
Do While i < Dic.Count
Ke = Dic.keys '開始遍歷字典
MyName = Dir(Ke(i), vbDirectory) '查找目錄
Do While MyName <> ""
If MyName <> "." And MyName <> ".." Then
If (GetAttr(Ke(i) & MyName) And vbDirectory) = vbDirectory Then '如果是次級目錄
Dic.Add (Ke(i) & MyName & "\"), "" '就往字典中添加這個次級目錄名作為一個條目
End If
End If
MyName = Dir '繼續遍歷尋找
Loop
i = i + 1
Loop
Did.Add ("文件清單"), "" '以查找D盤下所有EXCEL文件為例
For Each Ke In Dic.keys
MyFileName = Dir(Ke & "*.xls")
Do While MyFileName <> ""
Did.Add (Ke & MyFileName), ""
MyFileName = Dir
Loop
Next
For Each Sh In ThisWorkbook.Worksheets
If Sh.Name = "XLS文件清單" Then
Sheets("XLS文件清單").Cells.Delete
F = True
Exit For
Else
F = False
End If
Next
If Not F Then
Sheets.Add.Name = "XLS文件清單"
End If
Sheets("XLS文件清單").[A1].Resize(Did.Count, 1) = WorksheetFunction.Transpose(Did.keys)
TT = Time - t
MsgBox Minute(TT) & "分" & Second(TT) & "秒"
End Sub

Ⅳ Excel vba批量提取文件名+修改文件名！

首先新建一個excel文件，然後打開該excel，接著，按F12另存為xlsm格式的文件，如下圖所示：

打開另存的文件xlsm，然後按ALT+F11，打開宏編輯界面，如下圖所示：

接下來找到thisworkbook的模塊，然後將如下的代碼，復制粘貼到指定的模塊中，如下圖所示： 代碼：Sub 批量獲取文件名() Cells = "" Dim sfso Dim myPath As String Dim Sh As Object Dim Folder As Object Application.ScreenUpdating = False On Error Resume Next Set sfso = CreateObject("Scripting.FileSystemObject") Set Sh = CreateObject("shell.application") Set Folder = Sh.BrowseForFolder(0, "", 0, "") If Not Folder Is Nothing Then myPath = Folder.Items.Item.Path End If Application.ScreenUpdating = True Cells(1, 1) = "舊版名稱" Cells(1, 2) = "文件類型" Cells(1, 3) = "所在位置" Cells(1, 4) = "新版名稱" Call 直接提取文件名(myPath "\") End Sub Sub 直接提取文件名(myPath As String) Dim i As Long Dim myTxt As String i = Range("A1048576").End(xlUp).Row myTxt = Dir(myPath, 31) Do While myTxt "" On Error Resume Next If myTxt ThisWorkbook.Name And myTxt "." And myTxt ".." And myTxt "081226" Then i = i + 1 Cells(i, 1) = "'" myTxt If (GetAttr(myPath myTxt) And vbDirectory) = vbDirectory Then Cells(i, 2) = "文件夾" Else Cells(i, 2) = "文件" End If Cells(i, 3) = Left(myPath, Len(myPath) - 1) End If myTxt = Dir Loop End Sub Sub 批量重命名() Dim y_name As String Dim x_name As String For i = 2 To Range("A1048576").End(xlUp).Row y_name = Cells(i, 3) "\" Cells(i, 1) x_name = Cells(i, 3) "\" Cells(i, 4) On Error Resume Next Name y_name As x_name Next End Sub

然後回到excel的使用界面，找到視圖當中的宏，點擊查看宏按鈕，如下圖所示：

接著會彈出使用宏的界面，我們先找到第一個過程，批量獲取文件名，並選擇執行，如下圖所示：

執行後，選擇好我們要批量命名的文件，如下圖的新建文件夾:

確定後，在excel即可得到如下的顯示，證明我們已經提取成功了文件名：

大家看一下，是不是和新建文件夾中的文件名一樣，如下圖所示：

然後在新版名稱中，輸入我們想變更後的名稱，如下圖所示：

注意，要將文件的擴展名加上，如下圖所示：

然後刪除掉沒用的列，如下圖所示：

同樣單擊視圖，宏當中的查看宏，調出我們的第二個過程，批量重命名，選擇執行，如下圖所示：

好了可以看到我們的文件重命名了，如下圖所示：

在這里提供給大家，視頻的演示：

Ⅵ excel vba打開文件 並且獲得文件名 保存

f = Dir(folder & "*.txt")
myfile = Dir
f 和 myfile 兩個變數混淆了