在excel VBA中重命名文件 [英] renaming files in excel VBA

问题描述

我在SF论坛上发现了以下Dos批处理脚本重命名多个文件与Dos批处理文件，它的工作原理如下：）

I found the following Dos batch script here on the SF forum Rename Multiple files with in Dos batch file and it works exactly as designed :)

我的问题是我从一个excel vba脚本和

My problem is that I execute this from within an excel vba script and

1. 我必须在VBA中构建一个Msgbox的延迟，否则VBA脚本的执行速度要比dos脚本重命名为需要，导致一个文件没有找到（它是在飞行中完成的，因为我需要它们）。

1. 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).

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

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).

更好的描述可能是：

我打开一张被自动分配一个数字的表单（在这个案例表14） - 然后，我触发一个vba脚本来找到一个特定于目录即keyw * .csv的文件，并将其重新命名为E.g14.csv，然后导入到其工作表中。在重命名目录之前，只有一个这样的文件开始出现在目录中的keyw * .csv。

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.

基本上我看到，我只能选择在DOS批处理文件中有一个不同的功能，甚至更好的是，在VBA宏中的MoveFile的基础上，但是当我在VBA中尝试MoveFile时，它不会识别*。

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 "*".

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

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

谢谢

这是我使用的DOS批处理：

this is the DOS batch I use:

REM DOS FILE

REM DOS FILE

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

这是相关的VBA脚本：

and this is the associated VBA script:

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已经被定义了

The script is stating an error "constant expression required" which I don't understand because the variable "vardir" is already defined

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 :)

THANKYOU CHRIS :)

在脚本中播放了一下，并整理了一下，现在已经完全正常运行了

Having played around with the script and tidied mine up a bit, it is now fully functional

工作表名称已经通过后端分配给任何新工作表，没有必要设置一个名称，但是如果有人会这样做，我已经包含并注释掉了一个Input v所以你只需输入工作表，剩下的就是自动化（只是取消注释这些行）。
显然，我没有输入底部的确切类型，因为每个人都想导入不同的行并更改不同的文件名，只需更改sKEY变量。

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.

再次感谢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

推荐答案

这样做的批处理文件使您的代码不必要地复杂。在VBA中做这些一个有用的工具是FileSystemObject

Running a batch file to do this is making your code unnecasarily complex. Do it all in VBA. One usefull tool is the FileSystemObject

早期绑定通过设置脚本类型库（Scrrun.dll）的引用

Early bind by seting a reference to the Scripting type library (Scrrun.dll)

Dim fso as FileSystemObject
Set fso = New FileSystemObject

晚期绑定如

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

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

There is lots of info on SO, in the documentation and online

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

FileSystemObject method to match a file using wildcard

搜索匹配模式的目录或文件的功能，返回第一个匹配文件

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

使用示例

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

这篇关于在excel VBA中重命名文件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！