Run file rename text string as a VBA statement

2019-08-27 04:22发布

问题:

I want to rename files using a VBA command stored in an MS Access subform text box. It may be of note the VBA commands are generated using a concatenation formula from a database query and copied into the text box.

This is essentially the code I'm attempting to use but I get runtime error 2434 - The expression you entered contains invalid syntax. There may be a better way than using the eval() command.

Public Function BulkRenameFile()
    Dim script As String
    script = "Name ""c:\ipfimport\PE2258N2754\2620.jpg"" As ""c:\ipfimport\PE2258N2754\PE2258N2754_PH1_20141216_2620.jpg"""
    BulkRenameFile = Eval(script)
    MsgBox ("Photo Renaming Complete")
End Function

Any help would be much appreciated.

回答1:

I post here two different routines, the 1st for renaming a single file and the second for renaming all files in a folder (or moving files from a folder to another). The 2nd accept a filter for renaming only a certain kind of files. They both use the FileSystemObject component (you must include Microsoft Scripting Runtime).

'--------------------------------------------------------
' Rename a file (returns the number of error, if any)
'--------------------------------------------------------
Public Function FileRename(strSourceFileName As String, strTargetFileName As String) As Integer
On Error GoTo Err_FileRename
    Dim fso As FileSystemObject

    Set fso = New FileSystemObject

    fso.MoveFile strSourceFileName, strTargetFileName

    Set fso = Nothing

Exit_FileRename:
    FileRename = Err.Number
    Exit Function

Err_FileRename:
    GoTo Exit_FileRename

End Function

'--------------------------------------------------------
' Massively rename files
'--------------------------------------------------------
Public Sub MoveFiles(SourceFolderPath As String, DestinationFolderPath As String, 
                     _ Optional FileFilter As String = "*.*")

    Dim fso As FileSystemObject, fld As Folder, fil As File
    Dim strDestinationFilePath  As String

    Set fso = New FileSystemObject
    Set fld = fso.GetFolder(SourceFolderPath)

    For Each fil In fld.Files

        If fil.Name Like FileFilter Then

            strDestinationFilePath = DestinationFolderPath + "\" + fil.Name
            FileMove fil.Path, strDestinationFilePath

        End If

    Next fil

    Set fld = Nothing
    Set fso = Nothing
End Sub



回答2:

In the end i changed the field expression in my query which builds a rename command from a VBA code to a DOS one. I paste the complete datasheet column of DOS rename codes into a textbox. The text box is exported as a .txt file and then run as a .bat in windows DOS command shell.

example DOS rename command pasted into a textbox:

rename "c:\ipfimport\PE2152N2380\*7112.jpg" "PE2152N2380_LT_T25_20140516_7112.jpg"
rename "c:\ipfimport\PE2152N2380\*7113.jpg" "PE2152N2380_LT_T25_20140516_7113.jpg"

The final working code:

Function FileRename()
 
Dim fso As New FileSystemObject
Dim stream As TextStream

strPath = [Forms]![File Rename > Main].Text_FilePathBase.Value
strFile = "Rename.bat"

Set stream = fso.CreateTextFile(strPath & strFile, True)

Debug.Print strPath & strFile

strForm = [Forms]![File Rename > Main].Text_PasteRenameScript.Value

stream.Write strForm

stream.Close
Set fso = Nothing
Set stream = Nothing

Call Shell(strPath & strFile, vbNormalFocus)

MsgBox ("Renaming Complete")

End Function