ループスルーフォルダのファイル拡張子を変更するVBA

Question

毎月ファイルごとに集計する必要があります。問題はファイルが「TXT」にある必要があることですが、それらは「WRI」として私に送信されます。

以下のようにハードコードされていると、一度に1つのファイルを作成できます。

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 

Answer 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 

Answer 2

私は個人的には、このためScripting.FileSystemObjectを使用したい - それは、手動でファイルパス文字列を構築するよりも、エラーのためにはるかに少ないがちです。あなたは、Microsoftスクリプトランタイムへの参照を追加する必要があります場合は気にしないで

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

注：それにディレクトリを渡すこと

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 

コール、それはあなたが名前変更を実行したいです末尾\かどうかがあります - これも動作します：あなたは `Dir`がどのように動作するかを検討する必要があるよう

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