导出Access的超链接到Excel

saraou

如附件,一个字段是超链接一个pdf,把这个表导出成为excel后里面只是显示超链接的文件名字,怎样设置才能显示超链接的全部路径从C盘一直到文件名字? 还有就是这个超链接是打不开的.如何才能让这个超链接能打开所链接的文件呢?

roych

你应该用绝对路径才能处理的。俺还特意录制了下视频供参考

1. '其它说明：
   
2. '1、需要引用Excel 11.0 库。
   
3. '2、超链接应设置为绝对路径（而不是相对路径），详见第二条记录。
   
4. Sub test()
   
5. 
   
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

复制代码

saraou

roych 发表于 2011-12-19 11:45
你应该用绝对路径才能处理的。俺还特意录制了下视频供参考

  非常感谢