如何禁用其他应用程序(记事本)的屏幕更新

时间:2016-12-09 09:55:49

标签: excel-vba csv notepad vba excel

我在vba中编写了一个宏,它用记事本打开一个文本文件,选择所有txt并将其复制到Excel。我必须以这种方式每天处理大约100个文件,我想要保留我观察到的闪烁图像。代码正在运行,但问题是命令

Application.Screenupdating = False

不使用记事本应用程序。我只能使用正常焦点,否则代码无效。如何在不注意打开和处理记事本文件的情况下执行下面的代码?

我的代码是:

Sub GetTextFile()
Application.ScreenUpdating = False
Dim MyPath As String
Dim MyFile As String

MyPath = "C:\Users\bgyona02\Desktop\OLAttachments\"

MyFile = Dir(MyPath & "*.txt", vbNormal)    

Do While Len(MyFile) > 0
  MyFile = Dir
Loop

Debug.Print GetTextFileContent(" C:\Users\bgyona02\Desktop\OLAttachments\" & MyFile)
    'MyFile = Shell("C:\WINDOWS\notepad.exe` C:\Users\bgyona02\Desktop\OLAttachments\" & MyFile, vbNormalFocus)
    'SendKeys "^a", True  '^A selects everything already in the pdf file.
    'SendKeys "^c", True
    'SendKeys "%fx", True
End Sub

我找不到任何解决方案。

2 个答案:

答案 0 :(得分:3)

快速回答如何运行记事本但隐藏窗口,并在vbHide命令中使用vbNormalFocus代替Shell

Dim strCmd = "C:\WINDOWS\notepad.exe C:\Users\bgyona02\Desktop\OLAttachments\" & LatestFile
MyFile = Shell(strCmd, vbHide)

但我非常怀疑SendKeys会在一个看不见的窗口上工作......

所以,这不是问题的答案,但您是否考虑过使用FileSystemObject而只是在不实际打开Notepad.exe的情况下阅读文件?

Option Explicit

Const FOR_READING = 1

Sub LoadTextFile()
    Dim varTxtContent As Variant
    Dim intLine As Integer

    'Debug.Print GetTextFileContent("D:\temp.txt")

    varTxtContent = Split(GetTextFileContent("D:\temp.txt"), vbCr, -1, vbBinaryCompare)
    For intLine = 0 To UBound(varTxtContent) - 1
        ThisWorkbook.Worksheets("Sheet1").Range("B" & intLine + 1).Value = varTxtContent(intLine)
    Next intLine


End Sub

Function GetTextFileContent(strPath As String) As String
    Dim strContent As String
    Dim objFso As Object
    Dim objFile As Object
    Dim objStream As Object

    strContent = ""
    On Error GoTo CleanUp:

    Set objFso = CreateObject("Scripting.FileSystemObject")
    Set objFile = objFso.GetFile(strPath)
    Set objStream = objFile.OpenAsTextStream(FOR_READING, 0)

    With objStream
        strContent = .ReadAll
        .Close
    End With

CleanUp:
    Set objStream = Nothing
    Set objFile = Nothing
    Set objFso = Nothing
    GetTextFileContent = strContent

End Function

该代码适用于重音字符,例如我的测试文本文件是:

â, î or ô
foo
bar foo
baz bar foo

据我所知,Application.ScreenUpdating仅适用于您的Excel会话,而不适用于在Windows中运行的其他程序。因此,要实际阻止那些出现的窗口 - 但仍然能够读取窗口的内容 - 您必须使用Windows API做一些相当复杂的事情。使用FileSystemObject非常简单。

HTH。

答案 1 :(得分:0)

我终于找到了一个非常优雅的解决方案,可以处理外部应用程序。所有的功劳都归功于Robert Schutt写的这部杰作代码。这使得记事本窗口为1像素,因此没有观察到闪烁的图像。对我来说这看起来相当复杂,但它节省了我的一天:

Option Explicit

Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long

Public Const GW_HWNDNEXT As Long = 2
Public Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwprocessid As Long) As Long

Function ProcIDFromWnd(ByVal hwnd As Long) As Long
   Dim idProc As Long

   ' Get PID for this HWnd
   GetWindowThreadProcessId hwnd, idProc
   ProcIDFromWnd = idProc
End Function

Function GetWinHandle(hInstance As Long) As Long
   Dim tempHwnd As Long

   ' Grab the first window handle that Windows finds:
   tempHwnd = FindWindow(vbNullString, vbNullString)

   ' Loop until you find a match or there are no more window handles:
   Do Until tempHwnd = 0
      ' Check if no parent for this window
      If GetParent(tempHwnd) = 0 Then
         ' Check for PID match
         If hInstance = ProcIDFromWnd(tempHwnd) Then
            ' Return found handle
            GetWinHandle = tempHwnd
            ' Exit search loop
            Exit Do
         End If
      End If

      ' Get the next window handle
      tempHwnd = GetWindow(tempHwnd, GW_HWNDNEXT)
   Loop
End Function

Sub MinimizeNotepad()
    Dim retval As Long, np_retval As Long
    np_retval = Shell("C:\notepad.exe", vbNormalFocus)
    retval = MoveWindow(GetWinHandle(np_retval), 1, 1, 1, 1, 1) ' Application.hwnd
End Sub