如何在不滚动的情况下截取整个电子邮件正文?

2024-05-15

我正在使用 OL2010,想要制作整个电子邮件的屏幕截图(不仅仅是“屏幕”)。

可以用VBA或者外部程序来完成吗?


有一个类似的问题 https://stackoverflow.com/questions/4176340关于如何使用 C# 实现这一点。注意这个答案 https://stackoverflow.com/a/4176361/22114,它解释了为什么在某些情况下它可能根本不可能。

有关如何捕获屏幕截图的一些 VB 示例代码,请参见本文 http://support.microsoft.com/kb/161299来自微软。以下是最相关的部分:

Option Explicit
Option Base 0

Private Type PALETTEENTRY
    peRed As Byte
    peGreen As Byte
    peBlue As Byte
    peFlags As Byte
End Type

Private Type LOGPALETTE
    palVersion As Integer
    palNumEntries As Integer
    palPalEntry(255) As PALETTEENTRY  ' Enough for 256 colors.
End Type

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type

Private Const RASTERCAPS As Long = 38
Private Const RC_PALETTE As Long = &H100
Private Const SIZEPALETTE As Long = 104

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Declare Function CreateCompatibleDC Lib "GDI32" (ByVal hDC As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "GDI32" ( _
    ByVal hDC As Long, _
    ByVal nWidth As Long, _
    ByVal nHeight As Long) As Long
Private Declare Function GetDeviceCaps Lib "GDI32" (ByVal hDC As Long, ByVal iCapabilitiy As Long) As Long
Private Declare Function GetSystemPaletteEntries Lib "GDI32" ( _
    ByVal hDC As Long, _
    ByVal wStartIndex As Long, _
    ByVal wNumEntries As Long, _
    lpPaletteEntries As PALETTEENTRY) As Long
Private Declare Function CreatePalette Lib "GDI32" (lpLogPalette As LOGPALETTE) As Long
Private Declare Function SelectObject Lib "GDI32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "GDI32" ( _
    ByVal hDCDest As Long, _
    ByVal XDest As Long, _
    ByVal YDest As Long, _
    ByVal nWidth As Long, _
    ByVal nHeight As Long, _
    ByVal hDCSrc As Long, _
    ByVal XSrc As Long, _
    ByVal YSrc As Long, _
    ByVal dwRop As Long) As Long
Private Declare Function DeleteDC Lib "GDI32" (ByVal hDC As Long) As Long
Private Declare Function GetForegroundWindow Lib "USER32" () As Long
Private Declare Function SelectPalette Lib "GDI32" ( _
    ByVal hDC As Long, _
    ByVal hPalette As Long, _
    ByVal bForceBackground As Long) As Long
Private Declare Function RealizePalette Lib "GDI32" (ByVal hDC As Long) As Long
Private Declare Function GetWindowDC Lib "USER32" (ByVal hWnd As Long) As Long
Private Declare Function GetDC Lib "USER32" (ByVal hWnd As Long) As Long
Private Declare Function GetWindowRect Lib "USER32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function ReleaseDC Lib "USER32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Declare Function GetDesktopWindow Lib "USER32" () As Long

Private Type PicBmp
    Size As Long
    Type As Long
    hBmp As Long
    hPal As Long
    Reserved As Long
End Type

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

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' CreateBitmapPicture
'    - Creates a bitmap type Picture object from a bitmap and
'      palette.
'
' hBmp
'    - Handle to a bitmap.
'
' hPal
'    - Handle to a Palette.
'    - Can be null if the bitmap doesn't use a palette.
'
' Returns
'    - Returns a Picture object containing the bitmap.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As Picture
    Dim r As Long
    Dim Pic As PicBmp
    ' IPicture requires a reference to "Standard OLE Types."
    Dim IPic As IPicture
    Dim IID_IDispatch As GUID

    ' Fill in with IDispatch Interface ID.
    With IID_IDispatch
        .Data1 = &H20400
        .Data4(0) = &HC0
        .Data4(7) = &H46
    End With

    ' Fill Pic with necessary parts.
    With Pic
        .Size = Len(Pic)    ' Length of structure.
        .Type = vbPicTypeBitmap   ' Type of Picture (bitmap).
        .hBmp = hBmp  ' Handle to bitmap.
        .hPal = hPal  ' Handle to palette (may be null).
    End With

    ' Create Picture object.
    r = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)

    ' Return the new Picture object.
    Set CreateBitmapPicture = IPic
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' CaptureWindow
'    - Captures any portion of a window.
'
' hWndSrc
'    - Handle to the window to be captured.
'
' LeftSrc, TopSrc, WidthSrc, HeightSrc
'    - Specify the portion of the window to capture.
'    - Dimensions need to be specified in pixels.
'
' Returns
'    - Returns a Picture object containing a bitmap of the specified
'      portion of the window that was captured.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function CaptureWindow( _
    ByVal hWndSrc As Long, _
    ByVal LeftSrc As Long, _
    ByVal TopSrc As Long, _
    ByVal WidthSrc As Long, _
    ByVal HeightSrc As Long) As Picture

    Dim hDCMemory As Long
    Dim hBmp As Long
    Dim hBmpPrev As Long
    Dim r As Long
    Dim hDCSrc As Long
    Dim hPal As Long
    Dim hPalPrev As Long
    Dim RasterCapsScrn As Long
    Dim HasPaletteScrn As Long
    Dim PaletteSizeScrn As Long
    Dim LogPal As LOGPALETTE

    ' Get device context for entire window.
    hDCSrc = GetWindowDC(hWndSrc)

    ' Create a memory device context for the copy process.
    hDCMemory = CreateCompatibleDC(hDCSrc)
    ' Create a bitmap and place it in the memory DC.
    hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)
    hBmpPrev = SelectObject(hDCMemory, hBmp)

    ' Get screen properties.
    RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS) ' Raster
    ' capabilities.
    HasPaletteScrn = RasterCapsScrn And RC_PALETTE ' Palette
    ' support.
    PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE) ' Size of
    ' palette.

    ' If the screen has a palette make a copy and realize it.
    If HasPaletteScrn And (PaletteSizeScrn = 256) Then
        ' Create a copy of the system palette.
        LogPal.palVersion = &H300
        LogPal.palNumEntries = 256
        r = GetSystemPaletteEntries(hDCSrc, 0, 256, _
        LogPal.palPalEntry(0))
        hPal = CreatePalette(LogPal)
        ' Select the new palette into the memory DC and realize it.
        hPalPrev = SelectPalette(hDCMemory, hPal, 0)
        r = RealizePalette(hDCMemory)
    End If

    ' Copy the on-screen image into the memory DC.
    r = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc, TopSrc, vbSrcCopy)

    ' Remove the new copy of the  on-screen image.
    hBmp = SelectObject(hDCMemory, hBmpPrev)

    ' If the screen has a palette get back the palette that was
    ' selected in previously.
    If HasPaletteScrn And (PaletteSizeScrn = 256) Then
        hPal = SelectPalette(hDCMemory, hPalPrev, 0)
    End If

    ' Release the device context resources back to the system.
    r = DeleteDC(hDCMemory)
    r = ReleaseDC(hWndSrc, hDCSrc)

    ' Call CreateBitmapPicture to create a picture object from the
    ' bitmap and palette handles. Then return the resulting picture
    ' object.
    Set CaptureWindow = CreateBitmapPicture(hBmp, hPal)
End Function
本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)

如何在不滚动的情况下截取整个电子邮件正文? 的相关文章

  • 如何使用 xlwings 从 Python 调用 Excel 宏?

    我读过API docs http docs xlwings org api html对于 xlwings 并在解释器中使用 Workbook 和 Sheet 对象 但我不知道如何从 Python 调用宏 如何使用 xlwings 从 Pyt
  • VBA 使用 Like 运算符删除行

    简单的事情并不简单 我试图根据具有以 2L 开头的数据的特定列删除行 所以我写了这段代码 LastRow可以理解 Sub Cleanup For i 1 To LastRow If Range F i Like 2L Then Rows i
  • 如何从 500 个 .xls Excel 文件中的单元格中获取数据?

    我想问你如何从许多Excel中的几个确定的 并且总是相同的 单元格中获取数据 xls文件 即我有一个清单 xls文件位于一个文件夹中 每个文件内部都有相同的表 但具有不同的值 我想从以下位置获取数据A1 C2 E3从文件夹中的所有文件中提取
  • Excel VBA 中.Delete 和.Clear 的区别?

    有什么区别Worksheets 1 Cells Delete and Worksheets 1 Cells Clear 我问这个是因为我一直用 Clear清除我的工作表内容 但在我之前的帖子中我发现Worksheets 1 Cells De
  • 延迟宏以允许事件完成

    在尝试从宏内访问外部 API 函数集时 我发现有必要添加延迟 以便外部 API 有时间处理选择 实现这一点会带来一些困难 因为使用 Application Wait 或 Application Sleep 不起作用 在线搜索让我尝试使用 G
  • 将图表导出为图像有时会生成空文件

    I m doing a macro that exports all the charts in the sheet and then opens Outlook and attaches them However I ve noticed
  • 在 MS Outlook 中,报告所有未收到回复的已发送邮件

    我每天都会发送大量电子邮件 但常常无法跟踪哪些邮件得到了实际回复 有没有办法使用 VBA 脚本查看上周发送的所有消息 并检查他们是否收到回复 具体来说 是一份已发送电子邮件的报告 这些电子邮件尚未从至少一个发送到的地址收到回复 我了解一点
  • 将最后几个功能添加到我的调度模板生成器中

    感谢 StackOverflow 上的一些出色的人 我几乎完成了调度模板生成器的代码 我还想补充三件事 但我遇到了一些麻烦 当前细分 我有两张表 2 员工列表 和 X 模板 员工列表中的值是从单元格 D9 开始的一列员工姓名 然后将员工值转
  • VBA 完成 Internet 表单

    我正在寻找将 Excel 中的值放入网页的代码 Sub FillInternetForm Dim IE As Object Set IE CreateObject InternetExplorer Application IE naviga
  • 我可以获取VBA代码中的注释文本吗

    可以说我有以下内容 Public Sub Information TEST End Sub 有没有办法得到 TEST 结果 不知何故通过VBA 例如 在 PHP 中 有一个获取注释的好方法 这里有什么想法吗 编辑 应该有办法 因为像 MZ
  • VBA 中 AND 函数如何工作?

    如果这是一个愚蠢的问题 我很抱歉 但是 Excel VBA AND 函数是否检查其中的每个条件然后继续 或者在第一个 FALSE 条件处停止而不检查其他条件 我想知道出于优化目的 但到目前为止在网上没有找到任何相关信息 提前致谢 示例 如果
  • VBA ByRef 参数类型不匹配

    最初在我的主代码部分中 我有一个丑陋的 if 语句 尽管它会运行丑陋 我决定将其设为我要调用的函数 这导致我收到错误 编译错误 ByRef 参数类型不匹配 我的假设是该函数需要正确引用 尽管我一直在阅读文档并且不明白为什么 gt 声明 Sh
  • 使用输入作为显示日期的基础

    我需要一种方法来使用用户窗体上的输入来确定将在输出上显示的日期 这是我的代码 If StatusBox Value lt 23 59 And ShiftCode Value AP Then Cells emptyRow 8 Value Da
  • 在 Excel 中使用 VBA 设置图像透明度

    有没有办法使用 VBA 脚本对图像应用一些透明度 我录制了一个 宏 但似乎没有录制艺术效果 我已经找到了如何制作形状 但没有找到图像 这需要几个步骤 将自选图形 如矩形 放置在工作表上 使用以下方法将您的实际图片嵌入矩形中 ShapeRan
  • 如何在 Excel 中对“高”字符进行 HTML 编码或音译?

    在 Excel 中 如何将包含重音字符 大引号等的单元格内容转换为相同字符的 HTML 或音译纯文本版本 我们有一个 XLS 文档 其中包含一些 高 字符 数据已通过数据库连接提取 并且 Excel 似乎正确处理不同代码页中的各个单元格 或
  • 使用 VBScript 在日期字段值上选择错误的数据

    我有一张包含以下数据的表 现在 Excel 共有 36 个任务 每个任务有 4 列 第一个任务 即 Task1 名称将始终从 L 列开始 144 列描述了 36 个任务 现在我们需要按行进行检查 并需要检查 TNStart 开始日期 你们能
  • 如何使用vba复制Excel工作表中的动态范围

    我试图使宏中的范围是动态的 而不指定最后一行x Sheets SheetName Range A2 K1000 Copy在 1000 行中 我想将其更改为动态 因为有时我的数量会更少或更多 尝试这个 Sub Test Dim lRow as
  • 在 VBA 中捕获 shell 命令的输出值?

    发现这个功能http www cpearson com excel ShellAndWait aspx http www cpearson com excel ShellAndWait aspx 但我还需要捕获 shell 的输出 有什么代
  • Excel - 公式或宏根据链接到另一个单元格的另一个单元格填充单元格

    在 Excel 中 我试图根据其他两个单元格中包含的值创建一个单元格 我需要单元格 X 和 Y 来获取基于单元格 L 和 的数据 就像这样 X Y L 1 2 3 4 5 6 A 6 1 1 6 1 6 1 7 1 7 2 7 2 8 1
  • 删除 VBA 按钮集合

    我正在使用以下脚本在 Excel 中生成按钮 范围正是我希望放置它的位置 Sub CreateAddButton rng As Range Dim btn As Button With Worksheets User Set btn But

随机推荐