vba 在excel VBA中重命名文件
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/7786296/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
renaming files in excel VBA
提问by Nigel Simmons
I found the following Dos batch script here on the SF forum Rename Multiple files with in Dos batch fileand it works exactly as designed :)
我在 SF 论坛Rename Multiple files with in Dos batch file上找到了以下 Dos 批处理脚本，它完全按设计工作:)
My problem is that I execute this from within an excel vba script and
我的问题是我从一个 excel vba 脚本中执行这个
I have to build a delay E.G a Msgbox in the VBA otherwise the VBA script executes faster than the dos script renames the file that I need, resulting in a file not found (it's done on the fly and as I need them).
The excel workbook opens a sheet which is named between 1 and 800. If I want to open file 14.csv(according to the sheet name) the dos script won't help much because it renames the files in sequence, so 1,2,3,4,5 and not 1,2,3,4, 14 (or as required).
我必须在 VBA 中构建一个延迟 EG 一个 Msgbox，否则 VBA 脚本的执行速度比 dos 脚本重命名我需要的文件要快，从而导致找不到文件（它是在我需要时即时完成的）。
excel 工作簿打开一个名称在 1 到 800 之间的工作表。如果我想打开文件 14.csv（根据工作表名称），dos 脚本将无济于事，因为它按顺序重命名文件，所以 1,2 ,3,4,5 而不是 1,2,3,4,14（或根据需要）。
a better description maybe:
更好的描述也许是：
I open a sheet which is automatically assigned a number(in this case sheet 14) - I then trigger a vba script to find a file with a specific begining in the directory i.e "keyw*.csv" and rename this to E.g "14.csv" which is in turn, imported to its sheet. There is only ever ONE such file that begins "keyw*.csv" present in the directory before it's renamed.
我打开一个自动分配一个数字的工作表（在本例中为工作表 14） - 然后我触发一个 vba 脚本以在目录中查找具有特定开头的文件，即“keyw*.csv”并将其重命名为例如“14.csv”。 csv”，然后导入到其工作表中。在重命名之前，目录中只有一个以“keyw*.csv”开头的文件。
Basically as I see it, I only have the choice of a different function in a DOS batch file or even better, something on the basis of "MoveFile" in a VBA macro, but when I try "MoveFile" in VBA, it doesn't recognize the "*".
基本上在我看来，我只能在 DOS 批处理文件中选择不同的功能，甚至更好，基于 VBA 宏中的“MoveFile”，但是当我在 VBA 中尝试“MoveFile”时，它没有t 识别“*”。
Each time I download a file it begins with "keywords_blahbla" so the I need to use a wildcard to find it, in order to rename it. Obviously I could easily just open the directory and click on the file, but I really would like to automate the whole process so can you possibly guide me in the right direction
每次我下载一个文件时，它都以“keywords_blahbla”开头，所以我需要使用通配符来找到它，以便重命名它。显然我可以很容易地打开目录并单击文件，但我真的很想自动化整个过程，所以你可以指导我朝着正确的方向前进
thanks
谢谢
this is the DOS batch I use:
这是我使用的 DOS 批处理：
REM DOS FILE
REM DOS 文件
echo on cd\ cd c:\keywords\SOMETHING\
echo on cd\ cd c:\keywords\SOMETHING\
SETLOCAL ENABLEDELAYEDEXPANSION
SET count=3
FOR %%F IN (c:\keywords\SOMETHING\*.csv) DO MOVE "%%~fF" "%%~dpF!count!.csv" & SET /a
count=!count!+1
ENDLOCAL
and this is the associated VBA script:
这是关联的 VBA 脚本：
Dim vardirfull As String
Dim RetVal
Dim varInput As Variant
Dim fso As Object
vardirfull = Left(ThisWorkbook.Name, InStr(1, ThisWorkbook.Name, ".", vbTextCompare) - 1)
vardir = UCase(vardirfull)
varfil = ActiveSheet.Name
If Range("A2") <> "" Then
ActiveSheet.Range("A2:C1050").ClearContents
Selection.Hyperlinks.Delete
'-----------------------------------------
'using VBA input to open the file:
'varInput = InputBox("Please enter the NUMBER/NAME highlited at the bottom of this Worksheet or enter 'new' for a new Worksheet")
'If CStr(varInput) <> CStr(ActiveSheet.Name) Then GoTo MustBeSheetName
'-----------------------------------------
'using the DOS Batch:
'RetVal = Shell("C:\keywords\" & vardir & "\changeto3.bat", 1)
'MsgBox "check1 - C:\keywords\" & vardir & "\" & varfil & ".csv"
'-----------------------------------------
'using VBA to search without opening a dialog:(wildcard is not accepted)
Set fso = CreateObject("Scripting.FileSystemObject")
fso.MoveFile "C:\keywords\" & vardir & "\keyw*.csv", "C:\keywords\" & vardir & "\" & vardir & ".csv"
'MsgBox "pause to allow DOS to fully execute(if used)"
If (fso.FileExists("C:\keywords\" & vardir & "\" & varfil & ".csv")) Then
Set fso = Nothing
GoTo Contin
Else
MsgBox "No such File"
Exit Sub
End If
Contin:
Range("A2:B2").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\keywords\" & vardir & "\" & varfil & ".csv", Destination:=Range("$A"))
EDIT 1
编辑 1
The script is stating an error "constant expression required" which I don't understand because the variable "vardir" is already defined
脚本声明了一个错误“需要常量表达式”，我不明白，因为变量“vardir”已经定义
Dim vardirfull As String
vardirfull = Left(ThisWorkbook.Name, InStr(1, ThisWorkbook.Name, ".", vbTextCompare) - 1)
vardir = UCase(vardirfull)
ActiveSheet.Range("A2:C1050").ClearContents
Selection.Hyperlinks.Delete
'-----------------------------------------
Dim sNewFile As String
Dim sh As Worksheet
Dim qt As QueryTable
Dim sConn As String
Const sPATH As String = "C:\magickeys\" & vardir & "\" **'(error:constant expression required**
Const sKEY As String = "keyw"
'I'm not sure how your sheet gets named, so I'm naming
'it explicitly here
Set sh = ActiveSheet
'sh.Name = "14"
sNewFile = sh.Name & ".csv"
'look for 'keyword' file
sOldFile = Dir(sPATH & sKEY & "*.csv")
'if file is found
If Len(sOldFile) > 0 Then
'rename it
Name sPATH & sOldFile As sPATH & sNewFile
End If
EDIT 2: SOLVED
编辑 2：已解决
THANKYOU CHRIS :)
谢谢克里斯:)
Having played around with the script and tidied mine up a bit, it is now fully functional
玩过脚本并整理了一下我的脚本，它现在功能齐全
As the sheet name is already assigned to any new sheet via the backend, there was no need to set a name but in case anyone would like this, I've included and commented out an Input variation, so you just enter the sheetname and the rest is automated(simply uncomment those lines). Obviously I have left out the exact type of import at the bottom as everyone would like to import different rows and to change a different filename, simply change the "sKEY" variable.
由于工作表名称已通过后端分配给任何新工作表，因此无需设置名称，但如果有人愿意，我已经包含并注释掉了输入变体，因此您只需输入工作表名称和休息是自动化的（只需取消注释这些行）。显然，我在底部省略了确切的导入类型，因为每个人都希望导入不同的行并更改不同的文件名，只需更改“sKEY”变量即可。
Thanks again Chris
再次感谢克里斯
Sub RenameandImportNewFile()
'Dim varInput As Variant
'varInput = InputBox("Rename this sheet and the File to be imported will be named accordingly or Cancel, vbCancel")
'If varInput = "" Then Exit Sub
'ActiveSheet.Name = varInput
Dim fso As FileSystemObject
Dim Fl As file
Dim vardirfull As String
Dim sPATH As String
Dim sKEY As String
Dim sNewFile As String
vardirfull = Left(ThisWorkbook.Name, InStr(1, ThisWorkbook.Name, ".", vbTextCompare) - 1)
vardir = UCase(vardirfull)
sPATH = "C:\magickeys\" & vardir & "\"
sKEY = "key"
sh = ActiveSheet.Name
sNewFile = sPATH & sh & ".csv"
ActiveSheet.Range("A2:C1050").ClearContents
Selection.Hyperlinks.Delete
'-----------------------------------------
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists(sNewFile)) Then
GoTo Contin
Else
MsgBox "The File : " & sNewFile & " will now be created"
End If
sOldFile = sPATH & sKEY & "*.csv"
'------------------------------------------
Set fso = New FileSystemObject
Set Fl = FindFile(fso, "C:\magickeys\" & vardir & "\", "key*.csv")
If Fl Is Nothing Then
MsgBox "No Files Found"
Exit sub
Else
MsgBox "Found " & Fl.Name
If Len(sOldFile) > 0 Then
Name Fl As sNewFile
'------------------------------------------
Contin:
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & sNewFile, Destination:=Range("$A"))
'here the rows you want to import
end sub
include this function after the sub
在 sub 之后包含这个函数
Function FindFile(ByRef fso As FileSystemObject, FolderSpec As String, FileSpec As String) As file
Dim Fld As folder
Dim Fl As file
Set Fld = fso.GetFolder(FolderSpec)
For Each Fl In Fld.Files
If Fl.Name Like FileSpec Then
' return first matching file
Set FindFile = Fl
GoTo Cleanup:
End If
Next
Set FindFile = Nothing
Cleanup:
Set Fl = Nothing
Set Fld = Nothing
Set fso = Nothing
End Function
回答by chris neilsen
Running a batch file to do this is making your code unnecasarily complex. Do it all in VBA. One usefull tool is the FileSystemObject
运行批处理文件来执行此操作会使您的代码变得不必要地复杂。在 VBA 中完成所有操作。一个有用的工具是 FileSystemObject
Early bind by seting a reference to the Scripting type library (Scrrun.dll)
通过设置对脚本类型库 (Scrrun.dll) 的引用进行早期绑定
Dim fso as FileSystemObject
Set fso = New FileSystemObject
Late bind like
晚绑定喜欢
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
There is lots of info on SO, in the documentation and online
在文档和在线上有很多关于 SO 的信息
EDIT:FileSystemObject method to match a file using wildcard
编辑：使用通配符匹配文件的 FileSystemObject 方法
Function to search a directory or files matching a pattern, return first matching file found
搜索匹配模式的目录或文件的函数，返回找到的第一个匹配文件
Function FindFile(ByRef fso As FileSystemObject, FolderSpec As String, FileSpec As String) As file
Dim Fld As Folder
Dim Fl As file
Set Fld = fso.GetFolder(FolderSpec)
For Each Fl In Fld.Files
If Fl.Name Like FileSpec Then
' return first matching file
Set FindFile = Fl
GoTo Cleanup:
End If
Next
Set FindFile = Nothing
Cleanup:
Set Fl = Nothing
Set Fld = Nothing
Set fso = Nothing
End Function
Example of Use
使用示例
Sub DemoFindFile()
Dim fso As FileSystemObject
Dim Fl As file
Set fso = New FileSystemObject
Set Fl = FindFile(fso, "C:\temp", "File*.txt")
If Fl Is Nothing Then
MsgBox "No Files Found"
Else
MsgBox "Found " & Fl.Name
End If
Set Fl = Nothing
Set fso = Nothing
End Sub
回答by Dick Kusleika
I don't totally understand your workflow here, but hopefully the below will give you enough information to adapt it to your situation.
我不完全了解您在这里的工作流程，但希望以下内容能为您提供足够的信息以使其适应您的情况。
Sub ImportCSV()
Dim sOldFile As String
Dim sNewFile As String
Dim sh As Worksheet
Dim qt As QueryTable
Dim sConn As String
Const sPATH As String = "C:\Users\dick\TestPath\"
Const sKEY As String = "keyword"
'I'm not sure how your sheet gets named, so I'm naming
'it explicitly here
Set sh = ActiveSheet
sh.Name = "14"
sNewFile = sh.Name & ".csv"
'look for 'keyword' file
sOldFile = Dir(sPATH & sKEY & "*.csv")
'if file is found
If Len(sOldFile) > 0 Then
'rename it
Name sPATH & sOldFile As sPATH & sNewFile
'create connection string
sConn = "TEXT;" & sPATH & sNewFile
'import text file
Set qt = sh.QueryTables.Add(sConn, sh.Range("A2"))
'refresh to show data
qt.Refresh
End If
End Sub
