循环文件夹更改文件扩展名VBA

时间:2017-03-01 18:35:18

标签: excel vba excel-vba

每月我必须汇总每日文件。问题是我需要将文件放在“TXT”中,但它们会以“WRI”的形式发送给我。

如果使用以下内容进行硬编码,我一次可以执行一个文件。

Name "C:\Users\John\Desktop\Folder1\SQLEXEC.WRI" As "C:\Users\John\Desktop\Folder1\SQLEXEC.TXT"

但是,我希望能够遍历该文件夹。但我不知道如何更改代码以允许它循环。

Sub ConvertToTXT()

Application.DisplayAlerts = False 
Application.ScreenUpdating = False

Dim strPath As String 
Dim strFile As String

strPath = "C:\Users\John\Desktop\Folder1\" strFile = Dir(strPath & "*.wri")

Do While strFile <> ""

Name "C:\Users\John\Desktop\Folder1\SQLEXEC.WRI" As "C:\Users\John\Desktop\Folder1\SQLEXEC.TXT"

Loop

End Sub

2 个答案:

答案 0 :(得分:1)

Sub ConvertToTXT()

    Const strPath As String = "C:\Users\John\Desktop\Folder1"
    Dim strFile As String

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    strFile = Dir(strPath & "\" & "*.wri")

    Do While strFile <> ""
        Name strPath & "\" & strFile As strPath & "\" & Replace(strFile, ".wri", ".txt")
        strFile = Dir
    Loop

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

答案 1 :(得分:0)

我个人使用Scripting.FileSystemObject - 它比手动构建文件路径字符串更不容易出错。您需要添加对Microsoft Scripting Runtime的引用:

Private Sub ConvertToTXT(filePath As String)
    With New Scripting.FileSystemObject
        Dim directory As Folder
        Set directory = .GetFolder(filePath)
        Dim target As File
        For Each target In directory.Files
            If LCase$(.GetExtensionName(target.Name)) = "wri" Then
                Dim newName As String
                newName = .BuildPath(filePath, .GetBaseName(target.Name)) & ".txt"
                .MoveFile target.Path, newName
            End If
        Next
    End With
End Sub

通过将要执行重命名的目录传递给它来调用它:

ConvertToTXT "C:\Users\John\Desktop\Folder1"

请注意,如果有\跟踪,则无关紧要 - 这也有效:

ConvertToTXT "C:\Users\John\Desktop\Folder1\"