打開一個CSV文件並使用不同的名稱和文件路徑保存相同的CSV

Question

OK，所以我在嘗試打開一個名爲「testymctesttest_0001a.csv」的文件時遇到了問題，然後重命名並保存同名文件名爲「001a 「到不同的文件夾。我試圖在給定文件夾中的大約700個文件上執行此操作。有些人在號碼末尾有一個字母（例如0001a），有些則沒有該字母（例如0218）。有沒有辦法做到這一點，而不是將所有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）只是保存新的文件名稱（ex0001a或0218）。

我已經搜索了很多地方找到答案，我覺得這是一個簡單的命令，我失蹤了。但我最終的目標只是使用Open filePaths（j）打開CSV文件，對於Input＃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