Excel VBA изменить имя файла TXT (удалить время)

Question

Как программно изменить имя файла .txt с помощью Excel VBA, мне нужен сценарий, где он будет проходить через папку, которая состоит из файлов TXT и удаляет время из его имени файла.

Исходное имя файла: ABC_ABCDE_ABCD_YYYYMMDDTTTTTT.txt Новое имя файла: ABC_ABCDE_ABCD_YYYYMMDD.txt

Заранее спасибо

Майк

Answer 1

В соответствии с моим пониманием вашего вопроса, я пишу код, который просит пользователя выбрать папку и переименовать файл .txt в соответствии с требованиями, вы можете добавить дополнительный код строки для идеальной работы

'call sub LoopThroughFiles   
'this sub is loop every file and rename it
Sub LoopThroughFiles()

    Dim txtfile As String, folderPath As String
    Dim newName As String

    folderPath = GetFolder()
    txtfile = Dir(folderPath & "\" & "*.txt")

    While txtfile <> ""

          If checkFormat(txtfile) = True Then
             newName = Left(txtfile, 23) & ".txt"
           On Error Resume Next
           'rename file is done here
    If Not txtfile = "" Then Name (folderPath + "\" + txtfile) As (folderPath + "\" + newName)
            On Error GoTo 0

         End If
        txtfile = Dir

    Wend
End Sub

'this function is for check format of file
'you may edit it as per your requirment
Function checkFormat(str As String) As Boolean
checkFormat = False
If Len(str) = 33 And Mid(str, 4, 1) = "_" Then
    checkFormat = True
End If

End Function

'this function for select folder path
Function GetFolder() As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set fldr = Nothing
End Function

Перед использованием этого кода, пожалуйста, сделайте дополнительную копию вашего файла на случай, если у вас есть какая-либо ошибка в резервной копии ... Надеюсь, что это поможет