CSVファイルを開いて別の名前とファイルパスを使用して同じCSVを保存する

Question

名前 "testymctesttest_0001a.csv"という名前のファイルを開いて名前を変更し、同じファイルを名前が "001a" "を別のフォルダに移動します。私は与えられたフォルダ内の約700のファイルでこれをしようとしています。番号の末尾に手紙（0001aなど）があり、手紙がありません（ex 0218）。そのCSVを別のCSVとして保存するだけで、すべてのcsvデータをワークブックにコピーすることなくこれを行う方法はありますか？以下のコードを試してみましたが、新しく保存されたCSVデータがすべて新しいフォルダで破損していることを除いて、すべてが機能していました。

Sub openSavefile() 

Dim filePaths() As String 
Dim lineFromFile As String 
Dim lineItems() As String 
Dim rowNum As Long 
Dim actWkb As Workbook 
Dim ary() As String 
Dim ary2() As String 
Dim fPath As String 
Dim i As Long 
Dim j As Long 

Application.ScreenUpdating = False 
Application.Calculation = xlCalculationManual 

Line1: 
filePaths = selectFilesFunc 

If filePaths(1) = "0" Then 
    Exit Sub 
End If 
If filePaths(1) = "-1" Then 
    GoTo Line1 
End If 

For j = 1 To UBound(filePaths) 

Workbooks.Add 
Set actWkb = ActiveWorkbook 
Cells(1, 1).Activate 
rowNum = 0 

ary = Split(filePaths(j), "\") 
ary2 = Split(ary(UBound(ary)), "_") 
ary = Split(ary2(UBound(ary2)), ".") 

Cells(1, 10).Value = ary(0) 
fPath = "H:\TEST\FR2\" 

Open filePaths(j) For Input As #1 
Do Until EOF(1) 
    Line Input #1, lineFromFile 
    lineItems = Split(lineFromFile, ",") 
    If UBound(lineItems) < 4 Then 
     For i = 0 To UBound(lineItems) 
      ActiveCell.Offset(rowNum, i).Value = lineItems(i) 
     Next i 
    Else 
     If lineItems(7) = "HEX" Then 
      Range("D" & rowNum + 1 & ":G" & rowNum + 1).NumberFormat = "@" 
      'Range("D" & rowNum + 1 & ":G" & rowNum + 1).HorizontalAlignment = xlRight 
     End If 

     For i = 0 To UBound(lineItems) 
      ActiveCell.Offset(rowNum, i).Value = lineItems(i) 
     Next i 
    End If 
    rowNum = rowNum + 1 
Loop 
actWkb.SaveAs fPath & ary(0) & ".csv" 
actWkb.Close 
Close #1 
Next j 

Application.ScreenUpdating = True 
Application.Calculation = xlCalculationAutomatic 

End Sub 

機能selectFilesFuncは、開くファイルパスの配列を取得します。配列インデックスary（0）は（ex 0001aまたは0218）として保存される新しいファイル名を保持します。

私は答えを見つけるために多くの場所を検索しました。私はそれが私が行方不明の単純なコマンドであるように感じます。しかし、私の最終的な目標は、Open FilePaths（j）を使用してCSVを開くことだけです。Input As＃1などの場合は、同じ名前のファイルを新しい名前とファイルパスで保存してください。しかし、CSVとして保存するためにブックをワークブックにインポートする必要がある場合は、データを破損することなくこれを行う方法を知りたいと思います。

ありがとうございました！

Answer 1

これはファイルを開くことなく行います。
それはちょうど最後のアンダースコアの後にテキストにファイルの名前を変更し、sSourceFolderからsDestinationFolderにファイルを移動します。

Public Sub RenameAndMove() 

    Dim colFiles As Collection 
    Dim vFile As Variant 
    Dim sFileName As String 
    Dim oFSO As Object 
    Dim sSourceFolder As String 
    Dim sDestinationFolder As String 

    Set colFiles = New Collection 
    sSourceFolder = "S:\DB_Development_DBC\Test\" 
    sDestinationFolder = "S:\DB_Development_DBC\Test1\" 

    EnumerateFiles sSourceFolder, "*.csv", colFiles 

    Set oFSO = CreateObject("Scripting.FileSystemObject") 
    For Each vFile In colFiles 
     'Get the new filename. 
     sFileName = Mid(vFile, InStrRev(vFile, "_") + 1, Len(vFile)) 
     On Error Resume Next 
      'Move the file. 
      oFSO.movefile vFile, sDestinationFolder & sFileName 
      'You can delete this row if you want. 
      'It states whether the move was successful in the Immediate window. 
      Debug.Print vFile & " = " & (Err.Number = 0) 
     Err.Clear 
    Next vFile 

End Sub 

Sub EnumerateFiles(ByVal sDirectory As String, _ 
    ByVal sFileSpec As String, _ 
    ByRef cCollection As Collection) 

    Dim sTemp As String 

    sTemp = Dir$(sDirectory & sFileSpec) 
    Do While Len(sTemp) > 0 
     cCollection.Add sDirectory & sTemp 
     sTemp = Dir$ 
    Loop 

End Sub