2010-03-16 131 views
11

我想使用vba截圖(然後將其作爲電子郵件附件發送)。理想情況下,我想截取活動表單的截圖。有沒有辦法做到這一點?有沒有辦法使用vba在MS-Access中截取屏幕截圖?

+0

你需要這是全自動的嗎?這就是爲什麼你不能使用Alt + PrintScreen? – 2010-03-16 18:23:19

+1

是的,它必須是自動的。我想把它放在代碼中,這樣當用戶執行特定操作時,就會截屏並通過電子郵件發送給管理員。 – dmr 2010-03-16 18:24:46

+1

或者快照可以作爲bmp保存到錯誤消息表中。以及其他信息,如活動表格名稱,工作站號碼,用戶ID,日期/時間等。 – 2010-03-17 00:39:49

回答

10

您必須使用Windows API調用來執行此操作。以下代碼在MS Access 2007中可用。它將保存BMP文件。

Option Compare Database 
Option Explicit 

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal _ 
    bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) 

Private Const VK_SNAPSHOT = &H2C 

Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long 

Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long 

Private Declare Function CloseClipboard Lib "user32"() As Long 

Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" _ 
(PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, _ 
IPic As IPicture) As Long 

'\\ Declare a UDT to store a GUID for the IPicture OLE Interface 
Private Type GUID 
    Data1 As Long 
    Data2 As Integer 
    Data3 As Integer 
    Data4(0 To 7) As Byte 
End Type 

'\\ Declare a UDT to store the bitmap information 
Private Type uPicDesc 
    Size As Long 
    Type As Long 
    hPic As Long 
    hPal As Long 
End Type 

Private Const CF_BITMAP = 2 
Private Const PICTYPE_BITMAP = 1 

Sub PrintScreen() 
    keybd_event VK_SNAPSHOT, 1, 0, 0 
End Sub 

Public Sub MyPrintScreen(FilePathName As String) 

    Call PrintScreen 

    Dim IID_IDispatch As GUID 
    Dim uPicinfo As uPicDesc 
    Dim IPic As IPicture 
    Dim hPtr As Long 

    OpenClipboard 0 
    hPtr = GetClipboardData(CF_BITMAP) 
    CloseClipboard 

    '\\ Create the interface GUID for the picture 
    With IID_IDispatch 
     .Data1 = &H7BF80980 
     .Data2 = &HBF32 
     .Data3 = &H101A 
     .Data4(0) = &H8B 
     .Data4(1) = &HBB 
     .Data4(2) = &H0 
     .Data4(3) = &HAA 
     .Data4(4) = &H0 
     .Data4(5) = &H30 
     .Data4(6) = &HC 
     .Data4(7) = &HAB 
    End With 

    '\\ Fill uPicInfo with necessary parts. 
    With uPicinfo 
     .Size = Len(uPicinfo) '\\ Length of structure. 
     .Type = PICTYPE_BITMAP '\\ Type of Picture 
     .hPic = hPtr '\\ Handle to image. 
     .hPal = 0 '\\ Handle to palette (if bitmap). 
    End With 

    '\\ Create the Range Picture Object 
    OleCreatePictureIndirect uPicinfo, IID_IDispatch, True, IPic 

    '\\ Save Picture Object 
    stdole.SavePicture IPic, FilePathName 

End Sub 

有一個Knowledge Base article進入更深入。

+0

對不起,從死亡中提出這個,但這也適用於Access 2003?如果沒有,我可以讓它工作嗎? – Magisch 2016-06-20 11:53:46

+0

我剛剛通過代碼..我不明白爲什麼它不會在Access 2003中工作,只要DLL存在。你有沒有嘗試過? – 2016-06-21 19:37:50

+0

實現工程....大致。如果剪貼板內容實際上是一個打印屏幕,那裏沒有檢查,但是直接調用它就好了。我現在留下的主要問題是,由此產生的圖像文件很大......大約6mb用於全屏幕。從我看到的Access 2003中沒有內置的方法將IPicture製作成.png並壓縮它,你碰巧知道一個嗎? – Magisch 2016-06-21 19:44:44

1

使用Raj的例子來獲取圖像,然後這個保存

Dim oPic 
On Error Resume Next 
Set oPic = Clipboard.GetData 
On Error GoTo 0 
If oPic Is Nothing Then 
    'no image in clipboard' 
Else 
    SavePicture oPic, "c:\temp\pic.bmp" 
end if 
+0

什麼是PastePicture? – 2010-03-16 19:03:07

+0

這是一個外部庫,我編輯了我的原始文章 – bugtussle 2010-03-16 19:04:01