访问 VBA - 导出到带有嵌入文件的 Excel

Question

我在 UA 上发布了这个，但我想我也会在这里尝试。 在 Access 2013 中，我有一个将数据导出和格式化到 Excel 电子表格的过程，包括嵌入图像和文档。 在循环浏览电子表格的附件时，如果附件是图像，则图标只是图像本身的一个小版本。 但如果附件是文档（Word、Excel 等），则使用的图标就是应用程序的图标。

在附加的屏幕截图中，您可以看到导出非常适合图像。 但是对于Excel文件，它在图标下方添加了无法删除的空白，并且图标的大小和比例是错误的。 对于 Word 文档，大小正确但图标没有显示； 但是您可以双击“看似空”的单元格并打开附件。 使用的图标来自 Windows Installer 图标文件。

下面是提取的代码。 它遍历包含将导出的附件的路径和类型以及要使用的图标的路径的表（附件文件不直接存储在数据库中；它们被引用）。

关于如何让图标正确显示的任何想法？

Private Sub cmdExport_Click()
On Error GoTo ErrProc
  
  Dim xlApp As Excel.Application    'Create an instance of Excel application
  Dim xlBook As Excel.Workbook      'Create a new Excel workbook
  Dim xlAtch As Excel.Worksheet      'Create a tab with Attachment details
  Dim strSQL As String              'SQL for the Attachment recordset
  Dim rsAtch As DAO.Recordset        'Attachment recordset
  Dim x As Integer                  'Counter for Attachment line numbers
  Dim Img As Excel.Shape            'Process the Image Attachments
  Dim Atch As OLEObject             'Process the non-Image Attachments
    
  'Create an instance of Excel.  Keep it hidden until it is finished
  Set xlApp = Excel.Application
  xlApp.Visible = False
  Set xlBook = xlApp.Workbooks.Add
  xlBook.Worksheets.Add
  
  'Build the Image Reference SQL
  strSQL = "SELECT * FROM tblAttachments"
  Set rsAtch = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
  
  'Add a new worksheet
  Set xlAtch = xlBook.Worksheets(1)
  
  With xlAtch
    'Build Column Headings
    .Range("A1").Value = "Name"
    .Range("B1").Value = "Attachment"
    .Range("C1").Value = "Attachment Path"
      
    .Range("A2:A5").RowHeight = 65
    .Columns("B").ColumnWidth = 17
    
    'Populate the detail data
    x = 2   'Set initial row counter
    Do While Not rsAtch.EOF
      .Range("A" & x).Value = Nz(rsAtch!AttachmentName, "")
      .Range("C" & x).Value = Nz(rsAtch!attachmentpath, "")

      If rsAtch!AttachmentType = "Image" Then
                  
        'Add the image; the initial size is set at 2000 and then resized below.
        Set Img = .Shapes.AddPicture(FileName:=rsAtch!attachmentpath, _
                  linktofile:=msoFalse, savewithdocument:=msoCTrue, _
                  Left:=.Range("B" & x).Left, Width:=2000, _
                  Top:=.Range("B" & x).Top, Height:=2000)
        
        'Resize the image
        Img.Width = .Range("B" & x).Width           'Width = cell width
        Img.Height = .Range("B" & x).Height         'Height = cell height
        Img.Placement = 1                           'Move and size with the cell
    
      Else 'non-image attachment
        Set Atch = .OLEObjects.Add(FileName:=rsAtch!attachmentpath, _
          iconindex:=0, _
          Link:=False, DisplayAsIcon:=True, IconFileName:=rsAtch!iconpath, _
          Left:=ActiveSheet.Range("B" & x).Left, Width:=.Range("B" & x).Width, _
          Top:=ActiveSheet.Range("B" & x).Top, Height:=.Range("B" & x).Height)
          
        Atch.Placement = 1                           'Move and size with the cell
      End If
      
      x = x + 1
      rsAtch.MoveNext
    Loop
    
    'Format the detail section as an Excel table
    .ListObjects.Add(xlSrcRange, Range("$A$1:$C$" & x - 1), , xlYes).Name = "Attachments"
    .Range("Attachments[#All]").Select
    .ListObjects("Attachments").TableStyle = "TableStyleLight8"
    
    .Range("A2").Select     'Put the focus on the first data cell
    .Columns("A:C").AutoFit 'Autofit the column widths
    
  End With

ExitProc:
  On Error Resume Next
  xlApp.Visible = True    'Set Excel to visible
  'Cleanup
  rsAtch.Close
  Set rsAtch = Nothing
  Set Img = Nothing
  Set Atch = Nothing
  
  Exit Sub
  
ErrProc:
  MsgBox Err.Number & "; " & Err.Description, vbOKOnly, "Error"
  Resume ExitProc

End Sub

Answer 1

我靠得更近了，可能就我得到的这个。 我一直使用的图标文件（PNG 格式）被复制并存储在一个图标目录中以供 Access 使用。 这在 Access 中显示图标时效果很好，但在导出时效果不佳。

在尝试了几十种参数和逻辑流程的组合后，我发现了一些“大部分”有效的东西。 对于参数，我不得不添加一个图标标签（我只使用文件名）并且不得不使用 Windows Installer 图标文件。 我在这个复杂的过程中遇到的大小调整仍然存在一些问题：首先调整我想要附件的单元格的大小，然后添加附件，然后调整附件的大小，然后再次调整单元格的大小。 输出适用于任何图像或 MS Office 文档附件。

这种方法的问题是：

1. 由于 PNG 文件不起作用，而且我只能使用 Windows Installer 图标，因此我无法获得非 Windows 程序的任何图标，例如 PDF 文件。
2. Windows Installer 图标位于我计算机上的“C:\\Windows\\Installer{90150000-0011-0000-1000-0000000FF1CE}”中，我确信该目录会因用户而异。 到目前为止，我无法找到任何类型的环境变量或其他引用来查找图标文件，而无需确切地知道在哪里查找。
3. 引用文件时，这些图标不再显示在 Access 中的表单上。 我认为这是因为图标实际上是可执行文件而不是图像文件。