Excel VBA 在记事本中打开 .CSV 并将全部复制到 Excel

Question

我已经搜索了互联网，但似乎无法找到我需要的确切解决方案。我有一个生成 .csv 格式报告的第三方程序。不幸的是，当您直接在 Excel 中打开 .csv 文件时，格式会很奇怪，A 列中有一些数据，B 列中有一些数据。但是，如果您在记事本中打开 .csv，然后将其粘贴到 Excel，数据很好。我有下面的代码，它将在记事本中打开文件，但不知道如何选择并将其复制到 Excel 中的单元格 A1 中。非常感谢您的帮助。

Dim FileToOpen

If MsgBox("Please open the file you wish to import, and be patient.  The macro will take 3-5 minutes to run.", _
    vbOKOnly, "Navigate") = 1 Then

    FileToOpen = Application.GetOpenFilename("Text Files (*.csv),*.csv")
    FileToOpen = Shell("Notepad.exe " & FileToOpen, 1)
End If

Answer 1

要回答您的问题，您可以使用 SendKeys（如果不使用等待时间或其他应用程序干扰，则发送键不正确）：

  Dim ws As Worksheet
  Set ws = ThisWorkbook.Worksheets("ReadText") 'whatever your worksheet is

'your code here

  FileToOpen = Shell("Notepad.exe " & FileToOpen, 1)

  waitTime (2000) 'as an alternative
  AppActivate FileToOpen, 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")
  ' rest of code

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

Answer 2

这些未经测试，但我发现了一些想法here：

试着调整一下：

Sub ImportText() 
    Dim Text 
    Dim i As Long 

    Application.ScreenUpdating = False 
     'put your own path below
    Open ActiveWorkbook.Path & "\MYFILE.txt" For Input As #1 
    i = 1 
    Do While Not EOF(1) ' Loop until end of file.
        Input #1, Text 
        Range("a" & i) = Text 
        i = i + 1 
    Loop 
    Close #1 
End Sub 

（这也出现在SO before）

或者

Dim myPlace as Range
Set myPlace = Cells(1,1)
Workbooks.OpenText Filename:=ActiveWorkbook.Path & "\MYFILE.txt", DataType:=xlDelimited, Tab:=True 
ActiveSheet.UsedRange.Copy Destination:=myPlace 
ActiveWorkbook.Close 

我不知道第二个是否可行，因为它只是以分隔符导入，并且正如您在上面提到的那样，看起来并不漂亮。但我留下了它，以防它出于某种原因确实有效。