#If VBA6 Then
         Private Const vbPicTypeBitmap As Long =  1 
         Private Const vbSrcCopy As Long = &HCC0020
         Private Const HORZRES As Long =  8 
         Private Const VERTRES As Long =  10 
      #End If

   #If VBA6 Then
      Public Function CaptureScreen() As IPictureDisp
         Dim hWndScreen As Long
         Dim hDCScreen As Long
         Dim nWidth As Long, nHeight As Long
         hWndScreen = GetDesktopWindow()
         hDCScreen = GetWindowDC(hWndScreen)
         nWidth = GetDeviceCaps(hDCScreen, HORZRES)
         nHeight = GetDeviceCaps(hDCScreen, VERTRES)
         ReleaseDC hWndScreen, hDCScreen
         Set CaptureScreen = CaptureWindow(hWndScreen, False,  0 ,  0 , _
            nWidth, nHeight)
      End Function
   
   #Else
       сюда переместить уже существующую функцию CaptureScreen
   #End If

SavePicture CaptureScreen, "C:\Temp\Screenshot.bmp"