Office中国论坛/Access中国论坛

标题: 导出Access的超链接到Excel [打印本页]
作者: saraou    时间: 2011-12-18 20:56
标题: 导出Access的超链接到Excel
如附件,一个字段是超链接一个pdf,把这个表导出成为excel后里面只是显示超链接的文件名字,怎样设置才能显示超链接的全部路径从C盘一直到文件名字? 还有就是这个超链接是打不开的.如何才能让这个超链接能打开所链接的文件呢?
[attach]47723[/attach]

[attach]47724[/attach]
作者: roych    时间: 2011-12-19 11:45
你应该用绝对路径才能处理的。俺还特意录制了下视频供参考
  1. '其它说明：
  2. '1、需要引用Excel 11.0 库。
  3. '2、超链接应设置为绝对路径（而不是相对路径），详见第二条记录。
  4. Sub test()

  6. Dim rst As New ADODB.Recordset
  7. Dim exl As Excel.Application
  8. Dim wk As Workbook
  9. Dim ws As Worksheet
  10. '打开记录集，并创建Excel控件。
  11. rst.Open "邮件列表", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
  12. Set exl = CreateObject("Excel.Application")
  13. '删除旧文件，如出错则跳步。
  14. On Error Resume Next
  15. If Dir("D:\邮件列表.xls") Then Kill "D:\邮件列表.xls"
  16. '创建工作簿，并激活第一个工作表
  17. Set wk = exl.Workbooks.Add()
  18. wk.Sheets(1).Activate
  19. Set ws = wk.ActiveSheet
  20. '写入表头
  21. For i = 0 To rst.Fields.Count - 1
  22.     ws.Range("A1").Offset(0, i) = rst.Fields(i).Name
  23. Next
  24. i = 0
  25. '写入记录内容
  26. For i = 1 To rst.RecordCount
  27.     ws.Range("A1").Offset(i, 0) = rst(0)
  28.     ws.Range("A1").Offset(i, 1) = rst(1)
  29.     ws.Range("A1").Offset(i, 2) = rst(2)
  30. '写入超链接公式。请特别留意里面的转义字符写法。
  31.     ws.Range("A1").Offset(i, 3) = "=hyperlink(""" & Left(rst(3), InStr(1, rst(3), "#")) & """,""" & Left(rst(3), InStr(1, rst(3), "#") - 1) & """)"
  32.     ws.Range("A1").Offset(i, 4) = rst(4)
  33.     rst.MoveNext
  34. Next
  35. '关闭记录集，保存数据后关闭电子表格。
  36. rst.Close
  37. Set rst = Nothing
  38. wk.SaveAs "D:\邮件列表.xls"
  39. wk.Close
  40. MsgBox "数据已成功导出到：D:\邮件列表.xls"
  41. End Sub
复制代码
[attach]47728[/attach]
作者: saraou    时间: 2011-12-19 16:33
roych 发表于 2011-12-19 11:45
你应该用绝对路径才能处理的。俺还特意录制了下视频供参考

  非常感谢



欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) Powered by Discuz! X3.3