excel - 如何在不更改的情况下将 csv 表复制到 excel 文件中

Question

我有一个 csv 文件，如下所示

当我选择所有单元格并将其手动复制/粘贴到另一个 Excel 文件中时，结果与原始文件相同。但是，尝试在 VBA 中做同样的事情会给我以下结果。

这是我正在使用的代码。

Sub test()
    Dim arr1 As Object
    Set arr1 = CreateObject("System.Collections.ArrayList")
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select"
        .AllowMultiSelect = False
        .InitialFileName = strPath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    '-----------------------------------------------------------
    Dim FileName As Variant
    FileName = Dir(GetFolder & "\")
    '-----------------------------------------------------------
    While FileName <> ""
        arr1.Add GetFolder & "\" & FileName
        FileName = Dir
    Wend
    '-----------------------------------------------------------
    Set fldr = Nothing
    Dim i As Long
    For i = 0 To arr1.Count - 1
        '-------------------------------------------------------------------
        Dim wkbk As Workbook
        Set wkbk = Workbooks.Open(arr1(i))
        wb1 = wkbk.Name
        Set sht = wkbk.Worksheets(wkbk.Sheets(1).Name)
        wkbk.Sheets(sht.Name).Copy After:=ThisWorkbook.Sheets("START")
        ActiveSheet.Name = "NEW"
'        MsgBox wkbk.Name
'        ThisWorkbook.Sheets.Add.Name = "NEW"
'        wkbk.Sheets(sht.Name).Cells.Copy
'        ThisWorkbook.Sheets("NEW").Cells.Paste
        wkbk.Close False
    Next i
End Sub

有没有办法获得与手动执行相同的结果？

Answer 1

导入 CSV 文件

Option Explicit

Sub importCSV()
    
    Const InitialFolderPath As String = "F:\Test\2021"
    Const FilePattern As String = "*.csv"
    
    Dim dwb As Workbook: Set dwb = ThisWorkbook
    
    Dim FolderPath As String
    If Right(InitialFolderPath, 1) = "\" Then
        FolderPath = InitialFolderPath
    Else
        FolderPath = InitialFolderPath & "\"
    End If
        
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    With fd
        .Title = "Select"
        .AllowMultiSelect = False
        .InitialFileName = FolderPath
        If .Show = False Then
            MsgBox "You canceled."
            Exit Sub
        End If
        FolderPath = .SelectedItems(1) & "\"
    End With
    
    Dim arl As Object: Set arl = CreateObject("System.Collections.ArrayList")
    Dim FileName As String: FileName = Dir(FolderPath & FilePattern)
    Do While FileName <> ""
        arl.Add FolderPath & FileName
        FileName = Dir
    Loop
    
    Application.ScreenUpdating = False
    
    Dim swb As Workbook
    Dim sws As Worksheet
    Dim dws As Worksheet
    Dim shId As Long
    Dim i As Long
    For i = 0 To arl.Count - 1
        Set swb = Workbooks.Open(FileName:=arl(i), Local:=True)
        Set sws = swb.Worksheets(1)
        sws.Copy After:=dwb.Sheets(dwb.Sheets.Count)
        Set dws = ActiveSheet
        shId = shId + 1
        On Error GoTo NewSheetError
        dws.Name = "New" & shId
        On Error GoTo 0
        swb.Close False
    Next i
    'dwb.Save
    
    Application.ScreenUpdating = True
    
    Exit Sub
    
NewSheetError:
    shId = shId + 1
    Resume

End Sub