导入 CSV 文件会导致剪贴板错误

Question

我有一个宏可以将一堆 csv 文件导入到电子表格中。 csvs 每天更新，每天添加更多文件。目前我大约有 130 个。我打开每个 csv 复制全部内容并将它们全部粘贴到同一个工作表上。我收到 "There's a large amount of data on the clipboard....Do you want to keep it" 错误。我单击 'no'，宏继续运行。起初我在每个文件之后都收到了消息。我添加了应该在粘贴每个文件之后但在关闭之前转储剪贴板内容的代码。现在我在大约 40-50 个文件后收到消息，但我根本不应该收到它。我认为代码可以做到这一点，但我仍然收到错误消息。我找不到问题或我需要通过 google 添加的任何内容。如何确保在继续下一个文件之前清除剪贴板？

Option Explicit

Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function EmptyClipboard Lib "user32" () As Long
Public Declare Function CloseClipboard Lib "user32" () As Long

Sub ImportData()

Dim i As Variant
Dim lastrow As Long
Dim clastrow As Long
Dim filePath As String
Dim fileName As String
Dim count As Long
Dim importRange As Range
Dim currentData As Range
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim cws As Excel.Worksheet

Set cws = ThisWorkbook.Sheets("Raw_Data")

lastrow = cws.Cells(Rows.count, "a").End(xlUp).Row

If lastrow >= 5 Then
    Set currentData = cws.Range("a5:r" & lastrow)
Else
    Set currentData = cws.Range("a5:r" & 6)
End If

currentData.ClearContents

filePath = "C:\Local_Path"
fileName = Dir(filePath & "*.csv")

count = 1
Do While fileName <> ""

    Set wb = Excel.Workbooks.Open(filePath & fileName)
    Set ws = wb.Worksheets(1)

    lastrow = ws.Cells(Rows.count, "a").End(xlUp).Row

    Set importRange = ws.Range("a2:f" & lastrow)

    importRange.Copy

    If count = 1 Then
        cws.Cells(5, "a").PasteSpecial xlPasteValues
    ElseIf count > 1 Then
        clastrow = cws.Cells(Rows.count, "a").End(xlUp).Row + 1
        cws.Cells(clastrow, "a").PasteSpecial xlPasteValues
    End If

    OpenClipboard (0&)
    EmptyClipboard
    CloseClipboard

    wb.Close

    fileName = Dir
    count = count + 1
Loop
'more code to fix data errors and formats
end sub

Answer 1

您可以直接传递值而无需 copy/paste:

Do While fileName <> ""

    Set wb = Excel.Workbooks.Open(filePath & fileName)
    Set ws = wb.Worksheets(1)

    lastrow = ws.Cells(Rows.count, "a").End(xlUp).Row
    Set importRange = ws.Range("a2:f" & lastrow)

    clastrow = cws.Cells(Rows.count, "a").End(xlUp).Row + 1
    If clastrow < 5 then clastrow = 5

    'assign the range value directly 
    With importRange
        cws.Cells(clastrow, "a").Resize( _
              .rows.count, .columns.count).Value = .value
    End With  
    wb.Close False

    fileName = Dir
    count = count + 1
Loop

导入 CSV 文件会导致剪贴板错误

Importing CSV files creates a clipboard error

excel

clipboard

vba