Question

我能够将内容从记事本复制到Excel。

在将数据粘贴到最后一个填写的行下方时遇到了问题。

下面是代码的一部分。它粘贴数据，但是当到达下一个文本文件时，它说：ws.Paste Range("A1:A" & 1LastRow)

不支持的对象

Option Explicit

Dim p
Dim ws As Worksheet
Dim MyPath As String
Dim strFilename As String
Dim lLastRow As Long
Dim LC As Long
Dim s As Worksheet, t As String
Dim i As Long, K As Long
K = Sheets.Count
Set ws = ThisWorkbook.Worksheets("First Sheet")
Sheets("First Sheet").Columns(1).NumberFormat = "@"
Sheets("First Sheet").Columns(2).NumberFormat = "@"
Sheets("First Sheet").Columns(3).NumberFormat = "@"

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False

Set ws = ThisWorkbook.Worksheets("First Sheet")
lLastRow = ws.UsedRange.Rows(ws.UsedRange.Rows.Count).Row + 1
p = Shell("Notepad.exe " & myfile, vbNormalFocus)
waitTime (2000) 'as an alternative
AppActivate p, False
Application.SendKeys "^a", True 'sends select all command keys
waitTime (500)
Application.SendKeys "^c", True 'sends copy keys
waitTime (500)
ws.activate
ws.Paste Range("A1:A" & 1LastRow)

Loop

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
End Sub

Public Function waitTime(ms As Long)
    Application.Wait Now() + (ms / 24 / 60 / 60 / 1000)
End Function

共产国际建议的新代码

Sub ISINCompilerx2()
Dim handle As Integer
Dim wbDst As Workbook
Dim wsDst As Worksheet
Dim lastRow As Long
Dim MyPath As String
Dim strFilename As String
handle = FreeFile
Set wbDst = ThisWorkbook
Set wsDst = wbDst.Worksheets("First Sheet")
lastRow = wsDst.Cells(Rows.Count, "A").End(xlUp).Row + 1

MyPath = "W:\Product Platforms\ISIN- CUSIP Country of Corporation\August 2018\All Asset Classes\"
strFilename = Dir(MyPath, vbNormal)

Do While strFilename <> ""
    Dim buffer As String
    Open MyPath & strFilename For Input As #handle
    buffer = Input(LOF(handle), handle)  '<-- reads the entire contents of the file to "buffer"
    Close #handle

    With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .SetText buffer
        .PutInClipboard
    End With

    wsDst.Activate
    Range("A1").Select
    Selection.Paste
    Application.CutCopyMode = False
    strFilename = Dir()
Loop

End Sub

Answer 1

您错过了我上面的评论的重点：

您知道记事本只是打开文本文件，对吗？有一些您使用复制粘贴的原因，而不是简单地打开文件并直接读取？

如果有可用的本机解决方案并且易于实现，则不尝试“自动化”其他应用程序，将为您节省很多麻烦。我的意思不是使用 Excel 直接打开文本文件（或CSV文件），我的意思是使用VBA的内置功能直接从文件中读取。鉴于您可以将文本文件的全部内容轻松获取到SendKeys中，因此在记事本中打开文本文件以使用String将内容拖到剪贴板上是有点荒谬的：

Dim handle As Integer
handle = FreeFile

Dim buffer As String
Open myfile For Input As #handle
buffer = Input(LOF(handle), handle)  '<-- reads the entire contents of the file to "buffer"
Close #handle

如果需要从此处进行处理，只需处理String中的文本。如果要粘贴它在某个地方，那么您真正需要做的就是将其发送到剪贴板。如果您已有对“ Microsoft Forms 2.0对象库”的引用（例如，项目中有UserForm），则可以使用以下方法：

With New MSForms.DataObject
    .SetText buffer
    .PutInClipboard
End With

或者，如果您没有参考，则可以使用以下CLSID进行后期绑定：

With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    .SetText buffer
    .PutInClipboard
End With

一旦它在剪贴板上，您就可以将其粘贴到需要的任何地方。

从记事本复制并粘贴到Excel工作表的最后一行

1 个答案: