excel - 在Excel VBA中重命名文件

Question

我在SF论坛上发现了以下Dos批处理脚本Rename Multiple files with in Dos batch file它完全按照设计工作:)

我的问题是我从 Excel VBA 脚本中执行此操作并且

1. 我必须在 VBA 中构建一个延迟 E.G Msgbox，否则 VBA 脚本的执行速度比 dos 脚本重命名我需要的文件更快，导致找不到文件(这是即时完成的，正如我所言)需要它们)。

2. Excel工作簿打开一个名称在1到800之间的工作表。如果我想打开文件14.csv(根据工作表名称)，dos脚本不会有太大帮助，因为它会重命名中的文件序列，因此是 1,2,3,4,5，而不是 1,2,3,4, 14(或根据需要)。

也许有更好的描述:

我打开一个自动分配编号的工作表(在本例中为工作表 14) - 然后我触发一个 vba 脚本来查找目录中具有特定开头的文件，即“keyw*.csv”，并将其重命名为 E.g “14.csv”又被导入到其工作表中。在重命名之前，目录中仅存在一个以“keyw*.csv”开头的此类文件。

基本上，正如我所见，我只能选择 DOS 批处理文件中的不同函数，甚至更好，基于 VBA 宏中的“MoveFile”的函数，但是当我在 VBA 中尝试“MoveFile”时，它无法识别“*”。

每次我下载文件时，它都以“keywords_blahbla”开头，因此我需要使用通配符来查找它，以便重命名它。 显然，我可以轻松地打开目录并单击文件，但我真的很想自动化整个过程，所以你能否引导我走向正确的方向

谢谢

这是我使用的 DOS 批处理:

REM DOS 文件

回显 光盘\ 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

脚本指出错误“需要常量表达式”，我不明白，因为变量“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:已解决

谢谢克里斯:)

在修改了脚本并稍微整理了一下我的脚本后，它现在功能齐全

由于工作表名称已通过后端分配给任何新工作表，因此无需设置名称，但如果有人愿意，我已包含并注释掉了一个输入变体，因此您只需输入工作表名称，其余部分是自动的(只需取消注释这些行)。 显然，我在底部遗漏了导入的确切类型，因为每个人都想导入不同的行并更改不同的文件名，只需更改“sKEY”变量即可。

再次感谢克里斯

    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

在 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

运行批处理文件来执行此操作会使您的代码变得不必要的复杂。全部用 VBA 完成。一个有用的工具是 FileSystemObject

通过设置对脚本类型库 (Scrrun.dll) 的引用来早期绑定(bind)

Dim fso as FileSystemObject
Set fso = New FileSystemObject

后期绑定(bind)如

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

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

编辑: FileSystemObject 方法使用通配符匹配文件

搜索与模式匹配的目录或文件的函数，返回找到的第一个匹配文件

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