在Excel VBA中重命名文件

我在SF论坛上find了下面的Dos批处理脚本在Dosbatch file中重命名多个文件 ，它的工作原理与devise完全一样:)

我的问题是，我从一个Excel VBA脚本和

1. 我必须在VBA中build立一个延迟EG消息框，否则VBA脚本执行的速度比DOS脚本更快地重命名我需要的文件，导致没有find文件（它随时随地完成，因为我需要它们）。

2. excel工作簿将打开一个名为1到800的表格。如果我想要打开文件14.csv（根据表名称），dos脚本将不会有什么帮助，因为它会按顺序重命名文件，所以1,2 ，3,4,5而不是1,2,3,4,14（或按要求）。

更好的描述可能是：

我打开一个自动分配一个数字的表格（在本例中为表格14） – 然后触发一个vba脚本来find一个在目录中具有特定开始的文件，例如“keyw * .csv”，并将其重命名为Eg“14。 csv“，然后将其导入到其表单中。 在重命名之前，只有一个这样的文件在目录中出现“keyw * .csv”。

基本上就像我看到的那样，我只能在DOSbatch file中select不同的function，甚至更好，基于VBAmacros中的“MoveFile”，但是当我在VBA中尝试“MoveFile”时，不承认“*”。

每次我下载一个文件，它以“keywords_blahbla”开头，所以我需要使用通配符来find它，以便重命名它。 显然，我可以很容易地打开目录并点击文件，但我真的想自动化整个过程，所以你可以指导我在正确的方向

谢谢

这是我使用的DOS批处理：

REM DOS文件

echo 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 

这是关联的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$2")) 

编辑1

该脚本陈述了一个错误“常量expression式需要”，我不明白，因为variables“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 

编辑2：已解决

THANKYOU CHRIS 🙂

玩过剧本并整理了一下，现在已经完全实用了

由于工作表名称已经通过后端分配给任何新工作表，所以不需要设置名称，但是如果有人想要这样做，我已经包含并注释了input变体，因此您只需input工作表名称rest是自动的（简单的取消注释这些行）。 很明显，我已经在底部删除了导入的确切types，因为每个人都想导入不同的行并更改不同的文件名，只需更改“sKEY”variables即可。

再次感谢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$2")) 'here the rows you want to import end 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 

Answer 1

运行batch file来执行此操作会使代码非常复杂。 在VBA中完成这一切。 一个有用的工具是FileSystemObject

通过对脚本types库（Scrrun.dll）的引用进行早期绑定

 Dim fso as FileSystemObject Set fso = New FileSystemObject 

晚结合像

 Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") 

有很多关于SO的信息，在文档和在线上

编辑： FileSystemObject方法来匹配使用通配符的文件

函数search一个或一个匹配模式的文件，返回find的第一个匹配的文件

 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 

使用示例

 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 

Answer 2

我不完全理解你的工作stream程，但希望下面的内容能给你足够的信息，以适应你的情况。

 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